Add missing VdbeCoverage() and VdbeCoverageNeverTaken() macros to window.c.
[sqlite.git] / src / tclsqlite.c
blobe5984ec804ce507117197c39bbf083687b82d3a5
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.
11 *************************************************************************
12 ** A TCL Interface to SQLite. Append this file to sqlite3.c and
13 ** compile the whole thing to build a TCL-enabled version of SQLite.
15 ** Compile-time options:
17 ** -DTCLSH Add a "main()" routine that works as a tclsh.
19 ** -DTCLSH_INIT_PROC=name
21 ** Invoke name(interp) to initialize the Tcl interpreter.
22 ** If name(interp) returns a non-NULL string, then run
23 ** that string as a Tcl script to launch the application.
24 ** If name(interp) returns NULL, then run the regular
25 ** tclsh-emulator code.
27 #ifdef TCLSH_INIT_PROC
28 # define TCLSH 1
29 #endif
32 ** If requested, include the SQLite compiler options file for MSVC.
34 #if defined(INCLUDE_MSVC_H)
35 # include "msvc.h"
36 #endif
38 #if defined(INCLUDE_SQLITE_TCL_H)
39 # include "sqlite_tcl.h"
40 #else
41 # include "tcl.h"
42 # ifndef SQLITE_TCLAPI
43 # define SQLITE_TCLAPI
44 # endif
45 #endif
46 #include <errno.h>
49 ** Some additional include files are needed if this file is not
50 ** appended to the amalgamation.
52 #ifndef SQLITE_AMALGAMATION
53 # include "sqlite3.h"
54 # include <stdlib.h>
55 # include <string.h>
56 # include <assert.h>
57 typedef unsigned char u8;
58 #endif
59 #include <ctype.h>
61 /* Used to get the current process ID */
62 #if !defined(_WIN32)
63 # include <unistd.h>
64 # define GETPID getpid
65 #elif !defined(_WIN32_WCE)
66 # ifndef SQLITE_AMALGAMATION
67 # ifndef WIN32_LEAN_AND_MEAN
68 # define WIN32_LEAN_AND_MEAN
69 # endif
70 # include <windows.h>
71 # endif
72 # define GETPID (int)GetCurrentProcessId
73 #endif
76 * Windows needs to know which symbols to export. Unix does not.
77 * BUILD_sqlite should be undefined for Unix.
79 #ifdef BUILD_sqlite
80 #undef TCL_STORAGE_CLASS
81 #define TCL_STORAGE_CLASS DLLEXPORT
82 #endif /* BUILD_sqlite */
84 #define NUM_PREPARED_STMTS 10
85 #define MAX_PREPARED_STMTS 100
87 /* Forward declaration */
88 typedef struct SqliteDb SqliteDb;
91 ** New SQL functions can be created as TCL scripts. Each such function
92 ** is described by an instance of the following structure.
94 typedef struct SqlFunc SqlFunc;
95 struct SqlFunc {
96 Tcl_Interp *interp; /* The TCL interpret to execute the function */
97 Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */
98 SqliteDb *pDb; /* Database connection that owns this function */
99 int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */
100 char *zName; /* Name of this function */
101 SqlFunc *pNext; /* Next function on the list of them all */
105 ** New collation sequences function can be created as TCL scripts. Each such
106 ** function is described by an instance of the following structure.
108 typedef struct SqlCollate SqlCollate;
109 struct SqlCollate {
110 Tcl_Interp *interp; /* The TCL interpret to execute the function */
111 char *zScript; /* The script to be run */
112 SqlCollate *pNext; /* Next function on the list of them all */
116 ** Prepared statements are cached for faster execution. Each prepared
117 ** statement is described by an instance of the following structure.
119 typedef struct SqlPreparedStmt SqlPreparedStmt;
120 struct SqlPreparedStmt {
121 SqlPreparedStmt *pNext; /* Next in linked list */
122 SqlPreparedStmt *pPrev; /* Previous on the list */
123 sqlite3_stmt *pStmt; /* The prepared statement */
124 int nSql; /* chars in zSql[] */
125 const char *zSql; /* Text of the SQL statement */
126 int nParm; /* Size of apParm array */
127 Tcl_Obj **apParm; /* Array of referenced object pointers */
130 typedef struct IncrblobChannel IncrblobChannel;
133 ** There is one instance of this structure for each SQLite database
134 ** that has been opened by the SQLite TCL interface.
136 ** If this module is built with SQLITE_TEST defined (to create the SQLite
137 ** testfixture executable), then it may be configured to use either
138 ** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.
139 ** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.
141 struct SqliteDb {
142 sqlite3 *db; /* The "real" database structure. MUST BE FIRST */
143 Tcl_Interp *interp; /* The interpreter used for this database */
144 char *zBusy; /* The busy callback routine */
145 char *zCommit; /* The commit hook callback routine */
146 char *zTrace; /* The trace callback routine */
147 char *zTraceV2; /* The trace_v2 callback routine */
148 char *zProfile; /* The profile callback routine */
149 char *zProgress; /* The progress callback routine */
150 char *zAuth; /* The authorization callback routine */
151 int disableAuth; /* Disable the authorizer if it exists */
152 char *zNull; /* Text to substitute for an SQL NULL value */
153 SqlFunc *pFunc; /* List of SQL functions */
154 Tcl_Obj *pUpdateHook; /* Update hook script (if any) */
155 Tcl_Obj *pPreUpdateHook; /* Pre-update hook script (if any) */
156 Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */
157 Tcl_Obj *pWalHook; /* WAL hook script (if any) */
158 Tcl_Obj *pUnlockNotify; /* Unlock notify script (if any) */
159 SqlCollate *pCollate; /* List of SQL collation functions */
160 int rc; /* Return code of most recent sqlite3_exec() */
161 Tcl_Obj *pCollateNeeded; /* Collation needed script */
162 SqlPreparedStmt *stmtList; /* List of prepared statements*/
163 SqlPreparedStmt *stmtLast; /* Last statement in the list */
164 int maxStmt; /* The next maximum number of stmtList */
165 int nStmt; /* Number of statements in stmtList */
166 IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
167 int nStep, nSort, nIndex; /* Statistics for most recent operation */
168 int nVMStep; /* Another statistic for most recent operation */
169 int nTransaction; /* Number of nested [transaction] methods */
170 int openFlags; /* Flags used to open. (SQLITE_OPEN_URI) */
171 #ifdef SQLITE_TEST
172 int bLegacyPrepare; /* True to use sqlite3_prepare() */
173 #endif
176 struct IncrblobChannel {
177 sqlite3_blob *pBlob; /* sqlite3 blob handle */
178 SqliteDb *pDb; /* Associated database connection */
179 int iSeek; /* Current seek offset */
180 Tcl_Channel channel; /* Channel identifier */
181 IncrblobChannel *pNext; /* Linked list of all open incrblob channels */
182 IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */
186 ** Compute a string length that is limited to what can be stored in
187 ** lower 30 bits of a 32-bit signed integer.
189 static int strlen30(const char *z){
190 const char *z2 = z;
191 while( *z2 ){ z2++; }
192 return 0x3fffffff & (int)(z2 - z);
196 #ifndef SQLITE_OMIT_INCRBLOB
198 ** Close all incrblob channels opened using database connection pDb.
199 ** This is called when shutting down the database connection.
201 static void closeIncrblobChannels(SqliteDb *pDb){
202 IncrblobChannel *p;
203 IncrblobChannel *pNext;
205 for(p=pDb->pIncrblob; p; p=pNext){
206 pNext = p->pNext;
208 /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
209 ** which deletes the IncrblobChannel structure at *p. So do not
210 ** call Tcl_Free() here.
212 Tcl_UnregisterChannel(pDb->interp, p->channel);
217 ** Close an incremental blob channel.
219 static int SQLITE_TCLAPI incrblobClose(
220 ClientData instanceData,
221 Tcl_Interp *interp
223 IncrblobChannel *p = (IncrblobChannel *)instanceData;
224 int rc = sqlite3_blob_close(p->pBlob);
225 sqlite3 *db = p->pDb->db;
227 /* Remove the channel from the SqliteDb.pIncrblob list. */
228 if( p->pNext ){
229 p->pNext->pPrev = p->pPrev;
231 if( p->pPrev ){
232 p->pPrev->pNext = p->pNext;
234 if( p->pDb->pIncrblob==p ){
235 p->pDb->pIncrblob = p->pNext;
238 /* Free the IncrblobChannel structure */
239 Tcl_Free((char *)p);
241 if( rc!=SQLITE_OK ){
242 Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
243 return TCL_ERROR;
245 return TCL_OK;
249 ** Read data from an incremental blob channel.
251 static int SQLITE_TCLAPI incrblobInput(
252 ClientData instanceData,
253 char *buf,
254 int bufSize,
255 int *errorCodePtr
257 IncrblobChannel *p = (IncrblobChannel *)instanceData;
258 int nRead = bufSize; /* Number of bytes to read */
259 int nBlob; /* Total size of the blob */
260 int rc; /* sqlite error code */
262 nBlob = sqlite3_blob_bytes(p->pBlob);
263 if( (p->iSeek+nRead)>nBlob ){
264 nRead = nBlob-p->iSeek;
266 if( nRead<=0 ){
267 return 0;
270 rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
271 if( rc!=SQLITE_OK ){
272 *errorCodePtr = rc;
273 return -1;
276 p->iSeek += nRead;
277 return nRead;
281 ** Write data to an incremental blob channel.
283 static int SQLITE_TCLAPI incrblobOutput(
284 ClientData instanceData,
285 CONST char *buf,
286 int toWrite,
287 int *errorCodePtr
289 IncrblobChannel *p = (IncrblobChannel *)instanceData;
290 int nWrite = toWrite; /* Number of bytes to write */
291 int nBlob; /* Total size of the blob */
292 int rc; /* sqlite error code */
294 nBlob = sqlite3_blob_bytes(p->pBlob);
295 if( (p->iSeek+nWrite)>nBlob ){
296 *errorCodePtr = EINVAL;
297 return -1;
299 if( nWrite<=0 ){
300 return 0;
303 rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
304 if( rc!=SQLITE_OK ){
305 *errorCodePtr = EIO;
306 return -1;
309 p->iSeek += nWrite;
310 return nWrite;
314 ** Seek an incremental blob channel.
316 static int SQLITE_TCLAPI incrblobSeek(
317 ClientData instanceData,
318 long offset,
319 int seekMode,
320 int *errorCodePtr
322 IncrblobChannel *p = (IncrblobChannel *)instanceData;
324 switch( seekMode ){
325 case SEEK_SET:
326 p->iSeek = offset;
327 break;
328 case SEEK_CUR:
329 p->iSeek += offset;
330 break;
331 case SEEK_END:
332 p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
333 break;
335 default: assert(!"Bad seekMode");
338 return p->iSeek;
342 static void SQLITE_TCLAPI incrblobWatch(
343 ClientData instanceData,
344 int mode
346 /* NO-OP */
348 static int SQLITE_TCLAPI incrblobHandle(
349 ClientData instanceData,
350 int dir,
351 ClientData *hPtr
353 return TCL_ERROR;
356 static Tcl_ChannelType IncrblobChannelType = {
357 "incrblob", /* typeName */
358 TCL_CHANNEL_VERSION_2, /* version */
359 incrblobClose, /* closeProc */
360 incrblobInput, /* inputProc */
361 incrblobOutput, /* outputProc */
362 incrblobSeek, /* seekProc */
363 0, /* setOptionProc */
364 0, /* getOptionProc */
365 incrblobWatch, /* watchProc (this is a no-op) */
366 incrblobHandle, /* getHandleProc (always returns error) */
367 0, /* close2Proc */
368 0, /* blockModeProc */
369 0, /* flushProc */
370 0, /* handlerProc */
371 0, /* wideSeekProc */
375 ** Create a new incrblob channel.
377 static int createIncrblobChannel(
378 Tcl_Interp *interp,
379 SqliteDb *pDb,
380 const char *zDb,
381 const char *zTable,
382 const char *zColumn,
383 sqlite_int64 iRow,
384 int isReadonly
386 IncrblobChannel *p;
387 sqlite3 *db = pDb->db;
388 sqlite3_blob *pBlob;
389 int rc;
390 int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
392 /* This variable is used to name the channels: "incrblob_[incr count]" */
393 static int count = 0;
394 char zChannel[64];
396 rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
397 if( rc!=SQLITE_OK ){
398 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
399 return TCL_ERROR;
402 p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
403 p->iSeek = 0;
404 p->pBlob = pBlob;
406 sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
407 p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
408 Tcl_RegisterChannel(interp, p->channel);
410 /* Link the new channel into the SqliteDb.pIncrblob list. */
411 p->pNext = pDb->pIncrblob;
412 p->pPrev = 0;
413 if( p->pNext ){
414 p->pNext->pPrev = p;
416 pDb->pIncrblob = p;
417 p->pDb = pDb;
419 Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
420 return TCL_OK;
422 #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
423 #define closeIncrblobChannels(pDb)
424 #endif
427 ** Look at the script prefix in pCmd. We will be executing this script
428 ** after first appending one or more arguments. This routine analyzes
429 ** the script to see if it is safe to use Tcl_EvalObjv() on the script
430 ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much
431 ** faster.
433 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
434 ** command name followed by zero or more arguments with no [...] or $
435 ** or {...} or ; to be seen anywhere. Most callback scripts consist
436 ** of just a single procedure name and they meet this requirement.
438 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
439 /* We could try to do something with Tcl_Parse(). But we will instead
440 ** just do a search for forbidden characters. If any of the forbidden
441 ** characters appear in pCmd, we will report the string as unsafe.
443 const char *z;
444 int n;
445 z = Tcl_GetStringFromObj(pCmd, &n);
446 while( n-- > 0 ){
447 int c = *(z++);
448 if( c=='$' || c=='[' || c==';' ) return 0;
450 return 1;
454 ** Find an SqlFunc structure with the given name. Or create a new
455 ** one if an existing one cannot be found. Return a pointer to the
456 ** structure.
458 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
459 SqlFunc *p, *pNew;
460 int nName = strlen30(zName);
461 pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );
462 pNew->zName = (char*)&pNew[1];
463 memcpy(pNew->zName, zName, nName+1);
464 for(p=pDb->pFunc; p; p=p->pNext){
465 if( sqlite3_stricmp(p->zName, pNew->zName)==0 ){
466 Tcl_Free((char*)pNew);
467 return p;
470 pNew->interp = pDb->interp;
471 pNew->pDb = pDb;
472 pNew->pScript = 0;
473 pNew->pNext = pDb->pFunc;
474 pDb->pFunc = pNew;
475 return pNew;
479 ** Free a single SqlPreparedStmt object.
481 static void dbFreeStmt(SqlPreparedStmt *pStmt){
482 #ifdef SQLITE_TEST
483 if( sqlite3_sql(pStmt->pStmt)==0 ){
484 Tcl_Free((char *)pStmt->zSql);
486 #endif
487 sqlite3_finalize(pStmt->pStmt);
488 Tcl_Free((char *)pStmt);
492 ** Finalize and free a list of prepared statements
494 static void flushStmtCache(SqliteDb *pDb){
495 SqlPreparedStmt *pPreStmt;
496 SqlPreparedStmt *pNext;
498 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pNext){
499 pNext = pPreStmt->pNext;
500 dbFreeStmt(pPreStmt);
502 pDb->nStmt = 0;
503 pDb->stmtLast = 0;
504 pDb->stmtList = 0;
508 ** TCL calls this procedure when an sqlite3 database command is
509 ** deleted.
511 static void SQLITE_TCLAPI DbDeleteCmd(void *db){
512 SqliteDb *pDb = (SqliteDb*)db;
513 flushStmtCache(pDb);
514 closeIncrblobChannels(pDb);
515 sqlite3_close(pDb->db);
516 while( pDb->pFunc ){
517 SqlFunc *pFunc = pDb->pFunc;
518 pDb->pFunc = pFunc->pNext;
519 assert( pFunc->pDb==pDb );
520 Tcl_DecrRefCount(pFunc->pScript);
521 Tcl_Free((char*)pFunc);
523 while( pDb->pCollate ){
524 SqlCollate *pCollate = pDb->pCollate;
525 pDb->pCollate = pCollate->pNext;
526 Tcl_Free((char*)pCollate);
528 if( pDb->zBusy ){
529 Tcl_Free(pDb->zBusy);
531 if( pDb->zTrace ){
532 Tcl_Free(pDb->zTrace);
534 if( pDb->zTraceV2 ){
535 Tcl_Free(pDb->zTraceV2);
537 if( pDb->zProfile ){
538 Tcl_Free(pDb->zProfile);
540 if( pDb->zAuth ){
541 Tcl_Free(pDb->zAuth);
543 if( pDb->zNull ){
544 Tcl_Free(pDb->zNull);
546 if( pDb->pUpdateHook ){
547 Tcl_DecrRefCount(pDb->pUpdateHook);
549 if( pDb->pPreUpdateHook ){
550 Tcl_DecrRefCount(pDb->pPreUpdateHook);
552 if( pDb->pRollbackHook ){
553 Tcl_DecrRefCount(pDb->pRollbackHook);
555 if( pDb->pWalHook ){
556 Tcl_DecrRefCount(pDb->pWalHook);
558 if( pDb->pCollateNeeded ){
559 Tcl_DecrRefCount(pDb->pCollateNeeded);
561 Tcl_Free((char*)pDb);
565 ** This routine is called when a database file is locked while trying
566 ** to execute SQL.
568 static int DbBusyHandler(void *cd, int nTries){
569 SqliteDb *pDb = (SqliteDb*)cd;
570 int rc;
571 char zVal[30];
573 sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
574 rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
575 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
576 return 0;
578 return 1;
581 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
583 ** This routine is invoked as the 'progress callback' for the database.
585 static int DbProgressHandler(void *cd){
586 SqliteDb *pDb = (SqliteDb*)cd;
587 int rc;
589 assert( pDb->zProgress );
590 rc = Tcl_Eval(pDb->interp, pDb->zProgress);
591 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
592 return 1;
594 return 0;
596 #endif
598 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
599 !defined(SQLITE_OMIT_DEPRECATED)
601 ** This routine is called by the SQLite trace handler whenever a new
602 ** block of SQL is executed. The TCL script in pDb->zTrace is executed.
604 static void DbTraceHandler(void *cd, const char *zSql){
605 SqliteDb *pDb = (SqliteDb*)cd;
606 Tcl_DString str;
608 Tcl_DStringInit(&str);
609 Tcl_DStringAppend(&str, pDb->zTrace, -1);
610 Tcl_DStringAppendElement(&str, zSql);
611 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
612 Tcl_DStringFree(&str);
613 Tcl_ResetResult(pDb->interp);
615 #endif
617 #ifndef SQLITE_OMIT_TRACE
619 ** This routine is called by the SQLite trace_v2 handler whenever a new
620 ** supported event is generated. Unsupported event types are ignored.
621 ** The TCL script in pDb->zTraceV2 is executed, with the arguments for
622 ** the event appended to it (as list elements).
624 static int DbTraceV2Handler(
625 unsigned type, /* One of the SQLITE_TRACE_* event types. */
626 void *cd, /* The original context data pointer. */
627 void *pd, /* Primary event data, depends on event type. */
628 void *xd /* Extra event data, depends on event type. */
630 SqliteDb *pDb = (SqliteDb*)cd;
631 Tcl_Obj *pCmd;
633 switch( type ){
634 case SQLITE_TRACE_STMT: {
635 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
636 char *zSql = (char *)xd;
638 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
639 Tcl_IncrRefCount(pCmd);
640 Tcl_ListObjAppendElement(pDb->interp, pCmd,
641 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
642 Tcl_ListObjAppendElement(pDb->interp, pCmd,
643 Tcl_NewStringObj(zSql, -1));
644 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
645 Tcl_DecrRefCount(pCmd);
646 Tcl_ResetResult(pDb->interp);
647 break;
649 case SQLITE_TRACE_PROFILE: {
650 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
651 sqlite3_int64 ns = *(sqlite3_int64*)xd;
653 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
654 Tcl_IncrRefCount(pCmd);
655 Tcl_ListObjAppendElement(pDb->interp, pCmd,
656 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
657 Tcl_ListObjAppendElement(pDb->interp, pCmd,
658 Tcl_NewWideIntObj((Tcl_WideInt)ns));
659 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
660 Tcl_DecrRefCount(pCmd);
661 Tcl_ResetResult(pDb->interp);
662 break;
664 case SQLITE_TRACE_ROW: {
665 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
667 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
668 Tcl_IncrRefCount(pCmd);
669 Tcl_ListObjAppendElement(pDb->interp, pCmd,
670 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
671 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
672 Tcl_DecrRefCount(pCmd);
673 Tcl_ResetResult(pDb->interp);
674 break;
676 case SQLITE_TRACE_CLOSE: {
677 sqlite3 *db = (sqlite3 *)pd;
679 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
680 Tcl_IncrRefCount(pCmd);
681 Tcl_ListObjAppendElement(pDb->interp, pCmd,
682 Tcl_NewWideIntObj((Tcl_WideInt)db));
683 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
684 Tcl_DecrRefCount(pCmd);
685 Tcl_ResetResult(pDb->interp);
686 break;
689 return SQLITE_OK;
691 #endif
693 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
694 !defined(SQLITE_OMIT_DEPRECATED)
696 ** This routine is called by the SQLite profile handler after a statement
697 ** SQL has executed. The TCL script in pDb->zProfile is evaluated.
699 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
700 SqliteDb *pDb = (SqliteDb*)cd;
701 Tcl_DString str;
702 char zTm[100];
704 sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
705 Tcl_DStringInit(&str);
706 Tcl_DStringAppend(&str, pDb->zProfile, -1);
707 Tcl_DStringAppendElement(&str, zSql);
708 Tcl_DStringAppendElement(&str, zTm);
709 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
710 Tcl_DStringFree(&str);
711 Tcl_ResetResult(pDb->interp);
713 #endif
716 ** This routine is called when a transaction is committed. The
717 ** TCL script in pDb->zCommit is executed. If it returns non-zero or
718 ** if it throws an exception, the transaction is rolled back instead
719 ** of being committed.
721 static int DbCommitHandler(void *cd){
722 SqliteDb *pDb = (SqliteDb*)cd;
723 int rc;
725 rc = Tcl_Eval(pDb->interp, pDb->zCommit);
726 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
727 return 1;
729 return 0;
732 static void DbRollbackHandler(void *clientData){
733 SqliteDb *pDb = (SqliteDb*)clientData;
734 assert(pDb->pRollbackHook);
735 if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
736 Tcl_BackgroundError(pDb->interp);
741 ** This procedure handles wal_hook callbacks.
743 static int DbWalHandler(
744 void *clientData,
745 sqlite3 *db,
746 const char *zDb,
747 int nEntry
749 int ret = SQLITE_OK;
750 Tcl_Obj *p;
751 SqliteDb *pDb = (SqliteDb*)clientData;
752 Tcl_Interp *interp = pDb->interp;
753 assert(pDb->pWalHook);
755 assert( db==pDb->db );
756 p = Tcl_DuplicateObj(pDb->pWalHook);
757 Tcl_IncrRefCount(p);
758 Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));
759 Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));
760 if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)
761 || TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)
763 Tcl_BackgroundError(interp);
765 Tcl_DecrRefCount(p);
767 return ret;
770 #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
771 static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){
772 char zBuf[64];
773 sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", iArg);
774 Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);
775 sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", nArg);
776 Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);
778 #else
779 # define setTestUnlockNotifyVars(x,y,z)
780 #endif
782 #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
783 static void DbUnlockNotify(void **apArg, int nArg){
784 int i;
785 for(i=0; i<nArg; i++){
786 const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
787 SqliteDb *pDb = (SqliteDb *)apArg[i];
788 setTestUnlockNotifyVars(pDb->interp, i, nArg);
789 assert( pDb->pUnlockNotify);
790 Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
791 Tcl_DecrRefCount(pDb->pUnlockNotify);
792 pDb->pUnlockNotify = 0;
795 #endif
797 #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
799 ** Pre-update hook callback.
801 static void DbPreUpdateHandler(
802 void *p,
803 sqlite3 *db,
804 int op,
805 const char *zDb,
806 const char *zTbl,
807 sqlite_int64 iKey1,
808 sqlite_int64 iKey2
810 SqliteDb *pDb = (SqliteDb *)p;
811 Tcl_Obj *pCmd;
812 static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
814 assert( (SQLITE_DELETE-1)/9 == 0 );
815 assert( (SQLITE_INSERT-1)/9 == 1 );
816 assert( (SQLITE_UPDATE-1)/9 == 2 );
817 assert( pDb->pPreUpdateHook );
818 assert( db==pDb->db );
819 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
821 pCmd = Tcl_DuplicateObj(pDb->pPreUpdateHook);
822 Tcl_IncrRefCount(pCmd);
823 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
824 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
825 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
826 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey1));
827 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey2));
828 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
829 Tcl_DecrRefCount(pCmd);
831 #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
833 static void DbUpdateHandler(
834 void *p,
835 int op,
836 const char *zDb,
837 const char *zTbl,
838 sqlite_int64 rowid
840 SqliteDb *pDb = (SqliteDb *)p;
841 Tcl_Obj *pCmd;
842 static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
844 assert( (SQLITE_DELETE-1)/9 == 0 );
845 assert( (SQLITE_INSERT-1)/9 == 1 );
846 assert( (SQLITE_UPDATE-1)/9 == 2 );
848 assert( pDb->pUpdateHook );
849 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
851 pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
852 Tcl_IncrRefCount(pCmd);
853 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
854 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
855 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
856 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
857 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
858 Tcl_DecrRefCount(pCmd);
861 static void tclCollateNeeded(
862 void *pCtx,
863 sqlite3 *db,
864 int enc,
865 const char *zName
867 SqliteDb *pDb = (SqliteDb *)pCtx;
868 Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
869 Tcl_IncrRefCount(pScript);
870 Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
871 Tcl_EvalObjEx(pDb->interp, pScript, 0);
872 Tcl_DecrRefCount(pScript);
876 ** This routine is called to evaluate an SQL collation function implemented
877 ** using TCL script.
879 static int tclSqlCollate(
880 void *pCtx,
881 int nA,
882 const void *zA,
883 int nB,
884 const void *zB
886 SqlCollate *p = (SqlCollate *)pCtx;
887 Tcl_Obj *pCmd;
889 pCmd = Tcl_NewStringObj(p->zScript, -1);
890 Tcl_IncrRefCount(pCmd);
891 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
892 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
893 Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
894 Tcl_DecrRefCount(pCmd);
895 return (atoi(Tcl_GetStringResult(p->interp)));
899 ** This routine is called to evaluate an SQL function implemented
900 ** using TCL script.
902 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
903 SqlFunc *p = sqlite3_user_data(context);
904 Tcl_Obj *pCmd;
905 int i;
906 int rc;
908 if( argc==0 ){
909 /* If there are no arguments to the function, call Tcl_EvalObjEx on the
910 ** script object directly. This allows the TCL compiler to generate
911 ** bytecode for the command on the first invocation and thus make
912 ** subsequent invocations much faster. */
913 pCmd = p->pScript;
914 Tcl_IncrRefCount(pCmd);
915 rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
916 Tcl_DecrRefCount(pCmd);
917 }else{
918 /* If there are arguments to the function, make a shallow copy of the
919 ** script object, lappend the arguments, then evaluate the copy.
921 ** By "shallow" copy, we mean only the outer list Tcl_Obj is duplicated.
922 ** The new Tcl_Obj contains pointers to the original list elements.
923 ** That way, when Tcl_EvalObjv() is run and shimmers the first element
924 ** of the list to tclCmdNameType, that alternate representation will
925 ** be preserved and reused on the next invocation.
927 Tcl_Obj **aArg;
928 int nArg;
929 if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
930 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
931 return;
933 pCmd = Tcl_NewListObj(nArg, aArg);
934 Tcl_IncrRefCount(pCmd);
935 for(i=0; i<argc; i++){
936 sqlite3_value *pIn = argv[i];
937 Tcl_Obj *pVal;
939 /* Set pVal to contain the i'th column of this row. */
940 switch( sqlite3_value_type(pIn) ){
941 case SQLITE_BLOB: {
942 int bytes = sqlite3_value_bytes(pIn);
943 pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
944 break;
946 case SQLITE_INTEGER: {
947 sqlite_int64 v = sqlite3_value_int64(pIn);
948 if( v>=-2147483647 && v<=2147483647 ){
949 pVal = Tcl_NewIntObj((int)v);
950 }else{
951 pVal = Tcl_NewWideIntObj(v);
953 break;
955 case SQLITE_FLOAT: {
956 double r = sqlite3_value_double(pIn);
957 pVal = Tcl_NewDoubleObj(r);
958 break;
960 case SQLITE_NULL: {
961 pVal = Tcl_NewStringObj(p->pDb->zNull, -1);
962 break;
964 default: {
965 int bytes = sqlite3_value_bytes(pIn);
966 pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
967 break;
970 rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
971 if( rc ){
972 Tcl_DecrRefCount(pCmd);
973 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
974 return;
977 if( !p->useEvalObjv ){
978 /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
979 ** is a list without a string representation. To prevent this from
980 ** happening, make sure pCmd has a valid string representation */
981 Tcl_GetString(pCmd);
983 rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
984 Tcl_DecrRefCount(pCmd);
987 if( rc && rc!=TCL_RETURN ){
988 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
989 }else{
990 Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
991 int n;
992 u8 *data;
993 const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
994 char c = zType[0];
995 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
996 /* Only return a BLOB type if the Tcl variable is a bytearray and
997 ** has no string representation. */
998 data = Tcl_GetByteArrayFromObj(pVar, &n);
999 sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
1000 }else if( c=='b' && strcmp(zType,"boolean")==0 ){
1001 Tcl_GetIntFromObj(0, pVar, &n);
1002 sqlite3_result_int(context, n);
1003 }else if( c=='d' && strcmp(zType,"double")==0 ){
1004 double r;
1005 Tcl_GetDoubleFromObj(0, pVar, &r);
1006 sqlite3_result_double(context, r);
1007 }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
1008 (c=='i' && strcmp(zType,"int")==0) ){
1009 Tcl_WideInt v;
1010 Tcl_GetWideIntFromObj(0, pVar, &v);
1011 sqlite3_result_int64(context, v);
1012 }else{
1013 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
1014 sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
1019 #ifndef SQLITE_OMIT_AUTHORIZATION
1021 ** This is the authentication function. It appends the authentication
1022 ** type code and the two arguments to zCmd[] then invokes the result
1023 ** on the interpreter. The reply is examined to determine if the
1024 ** authentication fails or succeeds.
1026 static int auth_callback(
1027 void *pArg,
1028 int code,
1029 const char *zArg1,
1030 const char *zArg2,
1031 const char *zArg3,
1032 const char *zArg4
1033 #ifdef SQLITE_USER_AUTHENTICATION
1034 ,const char *zArg5
1035 #endif
1037 const char *zCode;
1038 Tcl_DString str;
1039 int rc;
1040 const char *zReply;
1041 /* EVIDENCE-OF: R-38590-62769 The first parameter to the authorizer
1042 ** callback is a copy of the third parameter to the
1043 ** sqlite3_set_authorizer() interface.
1045 SqliteDb *pDb = (SqliteDb*)pArg;
1046 if( pDb->disableAuth ) return SQLITE_OK;
1048 /* EVIDENCE-OF: R-56518-44310 The second parameter to the callback is an
1049 ** integer action code that specifies the particular action to be
1050 ** authorized. */
1051 switch( code ){
1052 case SQLITE_COPY : zCode="SQLITE_COPY"; break;
1053 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
1054 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
1055 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
1056 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
1057 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
1058 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
1059 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
1060 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
1061 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
1062 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
1063 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
1064 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
1065 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
1066 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
1067 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
1068 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
1069 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
1070 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
1071 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
1072 case SQLITE_READ : zCode="SQLITE_READ"; break;
1073 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
1074 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
1075 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
1076 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
1077 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
1078 case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;
1079 case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;
1080 case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;
1081 case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;
1082 case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;
1083 case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;
1084 case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break;
1085 case SQLITE_RECURSIVE : zCode="SQLITE_RECURSIVE"; break;
1086 default : zCode="????"; break;
1088 Tcl_DStringInit(&str);
1089 Tcl_DStringAppend(&str, pDb->zAuth, -1);
1090 Tcl_DStringAppendElement(&str, zCode);
1091 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
1092 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
1093 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
1094 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
1095 #ifdef SQLITE_USER_AUTHENTICATION
1096 Tcl_DStringAppendElement(&str, zArg5 ? zArg5 : "");
1097 #endif
1098 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
1099 Tcl_DStringFree(&str);
1100 zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY";
1101 if( strcmp(zReply,"SQLITE_OK")==0 ){
1102 rc = SQLITE_OK;
1103 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
1104 rc = SQLITE_DENY;
1105 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
1106 rc = SQLITE_IGNORE;
1107 }else{
1108 rc = 999;
1110 return rc;
1112 #endif /* SQLITE_OMIT_AUTHORIZATION */
1115 ** This routine reads a line of text from FILE in, stores
1116 ** the text in memory obtained from malloc() and returns a pointer
1117 ** to the text. NULL is returned at end of file, or if malloc()
1118 ** fails.
1120 ** The interface is like "readline" but no command-line editing
1121 ** is done.
1123 ** copied from shell.c from '.import' command
1125 static char *local_getline(char *zPrompt, FILE *in){
1126 char *zLine;
1127 int nLine;
1128 int n;
1130 nLine = 100;
1131 zLine = malloc( nLine );
1132 if( zLine==0 ) return 0;
1133 n = 0;
1134 while( 1 ){
1135 if( n+100>nLine ){
1136 nLine = nLine*2 + 100;
1137 zLine = realloc(zLine, nLine);
1138 if( zLine==0 ) return 0;
1140 if( fgets(&zLine[n], nLine - n, in)==0 ){
1141 if( n==0 ){
1142 free(zLine);
1143 return 0;
1145 zLine[n] = 0;
1146 break;
1148 while( zLine[n] ){ n++; }
1149 if( n>0 && zLine[n-1]=='\n' ){
1150 n--;
1151 zLine[n] = 0;
1152 break;
1155 zLine = realloc( zLine, n+1 );
1156 return zLine;
1161 ** This function is part of the implementation of the command:
1163 ** $db transaction [-deferred|-immediate|-exclusive] SCRIPT
1165 ** It is invoked after evaluating the script SCRIPT to commit or rollback
1166 ** the transaction or savepoint opened by the [transaction] command.
1168 static int SQLITE_TCLAPI DbTransPostCmd(
1169 ClientData data[], /* data[0] is the Sqlite3Db* for $db */
1170 Tcl_Interp *interp, /* Tcl interpreter */
1171 int result /* Result of evaluating SCRIPT */
1173 static const char *const azEnd[] = {
1174 "RELEASE _tcl_transaction", /* rc==TCL_ERROR, nTransaction!=0 */
1175 "COMMIT", /* rc!=TCL_ERROR, nTransaction==0 */
1176 "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
1177 "ROLLBACK" /* rc==TCL_ERROR, nTransaction==0 */
1179 SqliteDb *pDb = (SqliteDb*)data[0];
1180 int rc = result;
1181 const char *zEnd;
1183 pDb->nTransaction--;
1184 zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)];
1186 pDb->disableAuth++;
1187 if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
1188 /* This is a tricky scenario to handle. The most likely cause of an
1189 ** error is that the exec() above was an attempt to commit the
1190 ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
1191 ** that an IO-error has occurred. In either case, throw a Tcl exception
1192 ** and try to rollback the transaction.
1194 ** But it could also be that the user executed one or more BEGIN,
1195 ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
1196 ** this method's logic. Not clear how this would be best handled.
1198 if( rc!=TCL_ERROR ){
1199 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
1200 rc = TCL_ERROR;
1202 sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
1204 pDb->disableAuth--;
1206 return rc;
1210 ** Unless SQLITE_TEST is defined, this function is a simple wrapper around
1211 ** sqlite3_prepare_v2(). If SQLITE_TEST is defined, then it uses either
1212 ** sqlite3_prepare_v2() or legacy interface sqlite3_prepare(), depending
1213 ** on whether or not the [db_use_legacy_prepare] command has been used to
1214 ** configure the connection.
1216 static int dbPrepare(
1217 SqliteDb *pDb, /* Database object */
1218 const char *zSql, /* SQL to compile */
1219 sqlite3_stmt **ppStmt, /* OUT: Prepared statement */
1220 const char **pzOut /* OUT: Pointer to next SQL statement */
1222 unsigned int prepFlags = 0;
1223 #ifdef SQLITE_TEST
1224 if( pDb->bLegacyPrepare ){
1225 return sqlite3_prepare(pDb->db, zSql, -1, ppStmt, pzOut);
1227 #endif
1228 /* If the statement cache is large, use the SQLITE_PREPARE_PERSISTENT
1229 ** flags, which uses less lookaside memory. But if the cache is small,
1230 ** omit that flag to make full use of lookaside */
1231 if( pDb->maxStmt>5 ) prepFlags = SQLITE_PREPARE_PERSISTENT;
1233 return sqlite3_prepare_v3(pDb->db, zSql, -1, prepFlags, ppStmt, pzOut);
1237 ** Search the cache for a prepared-statement object that implements the
1238 ** first SQL statement in the buffer pointed to by parameter zIn. If
1239 ** no such prepared-statement can be found, allocate and prepare a new
1240 ** one. In either case, bind the current values of the relevant Tcl
1241 ** variables to any $var, :var or @var variables in the statement. Before
1242 ** returning, set *ppPreStmt to point to the prepared-statement object.
1244 ** Output parameter *pzOut is set to point to the next SQL statement in
1245 ** buffer zIn, or to the '\0' byte at the end of zIn if there is no
1246 ** next statement.
1248 ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned
1249 ** and an error message loaded into interpreter pDb->interp.
1251 static int dbPrepareAndBind(
1252 SqliteDb *pDb, /* Database object */
1253 char const *zIn, /* SQL to compile */
1254 char const **pzOut, /* OUT: Pointer to next SQL statement */
1255 SqlPreparedStmt **ppPreStmt /* OUT: Object used to cache statement */
1257 const char *zSql = zIn; /* Pointer to first SQL statement in zIn */
1258 sqlite3_stmt *pStmt = 0; /* Prepared statement object */
1259 SqlPreparedStmt *pPreStmt; /* Pointer to cached statement */
1260 int nSql; /* Length of zSql in bytes */
1261 int nVar = 0; /* Number of variables in statement */
1262 int iParm = 0; /* Next free entry in apParm */
1263 char c;
1264 int i;
1265 Tcl_Interp *interp = pDb->interp;
1267 *ppPreStmt = 0;
1269 /* Trim spaces from the start of zSql and calculate the remaining length. */
1270 while( (c = zSql[0])==' ' || c=='\t' || c=='\r' || c=='\n' ){ zSql++; }
1271 nSql = strlen30(zSql);
1273 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
1274 int n = pPreStmt->nSql;
1275 if( nSql>=n
1276 && memcmp(pPreStmt->zSql, zSql, n)==0
1277 && (zSql[n]==0 || zSql[n-1]==';')
1279 pStmt = pPreStmt->pStmt;
1280 *pzOut = &zSql[pPreStmt->nSql];
1282 /* When a prepared statement is found, unlink it from the
1283 ** cache list. It will later be added back to the beginning
1284 ** of the cache list in order to implement LRU replacement.
1286 if( pPreStmt->pPrev ){
1287 pPreStmt->pPrev->pNext = pPreStmt->pNext;
1288 }else{
1289 pDb->stmtList = pPreStmt->pNext;
1291 if( pPreStmt->pNext ){
1292 pPreStmt->pNext->pPrev = pPreStmt->pPrev;
1293 }else{
1294 pDb->stmtLast = pPreStmt->pPrev;
1296 pDb->nStmt--;
1297 nVar = sqlite3_bind_parameter_count(pStmt);
1298 break;
1302 /* If no prepared statement was found. Compile the SQL text. Also allocate
1303 ** a new SqlPreparedStmt structure. */
1304 if( pPreStmt==0 ){
1305 int nByte;
1307 if( SQLITE_OK!=dbPrepare(pDb, zSql, &pStmt, pzOut) ){
1308 Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1309 return TCL_ERROR;
1311 if( pStmt==0 ){
1312 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
1313 /* A compile-time error in the statement. */
1314 Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1315 return TCL_ERROR;
1316 }else{
1317 /* The statement was a no-op. Continue to the next statement
1318 ** in the SQL string.
1320 return TCL_OK;
1324 assert( pPreStmt==0 );
1325 nVar = sqlite3_bind_parameter_count(pStmt);
1326 nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *);
1327 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte);
1328 memset(pPreStmt, 0, nByte);
1330 pPreStmt->pStmt = pStmt;
1331 pPreStmt->nSql = (int)(*pzOut - zSql);
1332 pPreStmt->zSql = sqlite3_sql(pStmt);
1333 pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1];
1334 #ifdef SQLITE_TEST
1335 if( pPreStmt->zSql==0 ){
1336 char *zCopy = Tcl_Alloc(pPreStmt->nSql + 1);
1337 memcpy(zCopy, zSql, pPreStmt->nSql);
1338 zCopy[pPreStmt->nSql] = '\0';
1339 pPreStmt->zSql = zCopy;
1341 #endif
1343 assert( pPreStmt );
1344 assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
1345 assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
1347 /* Bind values to parameters that begin with $ or : */
1348 for(i=1; i<=nVar; i++){
1349 const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
1350 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
1351 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
1352 if( pVar ){
1353 int n;
1354 u8 *data;
1355 const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
1356 c = zType[0];
1357 if( zVar[0]=='@' ||
1358 (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
1359 /* Load a BLOB type if the Tcl variable is a bytearray and
1360 ** it has no string representation or the host
1361 ** parameter name begins with "@". */
1362 data = Tcl_GetByteArrayFromObj(pVar, &n);
1363 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
1364 Tcl_IncrRefCount(pVar);
1365 pPreStmt->apParm[iParm++] = pVar;
1366 }else if( c=='b' && strcmp(zType,"boolean")==0 ){
1367 Tcl_GetIntFromObj(interp, pVar, &n);
1368 sqlite3_bind_int(pStmt, i, n);
1369 }else if( c=='d' && strcmp(zType,"double")==0 ){
1370 double r;
1371 Tcl_GetDoubleFromObj(interp, pVar, &r);
1372 sqlite3_bind_double(pStmt, i, r);
1373 }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
1374 (c=='i' && strcmp(zType,"int")==0) ){
1375 Tcl_WideInt v;
1376 Tcl_GetWideIntFromObj(interp, pVar, &v);
1377 sqlite3_bind_int64(pStmt, i, v);
1378 }else{
1379 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
1380 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
1381 Tcl_IncrRefCount(pVar);
1382 pPreStmt->apParm[iParm++] = pVar;
1384 }else{
1385 sqlite3_bind_null(pStmt, i);
1389 pPreStmt->nParm = iParm;
1390 *ppPreStmt = pPreStmt;
1392 return TCL_OK;
1396 ** Release a statement reference obtained by calling dbPrepareAndBind().
1397 ** There should be exactly one call to this function for each call to
1398 ** dbPrepareAndBind().
1400 ** If the discard parameter is non-zero, then the statement is deleted
1401 ** immediately. Otherwise it is added to the LRU list and may be returned
1402 ** by a subsequent call to dbPrepareAndBind().
1404 static void dbReleaseStmt(
1405 SqliteDb *pDb, /* Database handle */
1406 SqlPreparedStmt *pPreStmt, /* Prepared statement handle to release */
1407 int discard /* True to delete (not cache) the pPreStmt */
1409 int i;
1411 /* Free the bound string and blob parameters */
1412 for(i=0; i<pPreStmt->nParm; i++){
1413 Tcl_DecrRefCount(pPreStmt->apParm[i]);
1415 pPreStmt->nParm = 0;
1417 if( pDb->maxStmt<=0 || discard ){
1418 /* If the cache is turned off, deallocated the statement */
1419 dbFreeStmt(pPreStmt);
1420 }else{
1421 /* Add the prepared statement to the beginning of the cache list. */
1422 pPreStmt->pNext = pDb->stmtList;
1423 pPreStmt->pPrev = 0;
1424 if( pDb->stmtList ){
1425 pDb->stmtList->pPrev = pPreStmt;
1427 pDb->stmtList = pPreStmt;
1428 if( pDb->stmtLast==0 ){
1429 assert( pDb->nStmt==0 );
1430 pDb->stmtLast = pPreStmt;
1431 }else{
1432 assert( pDb->nStmt>0 );
1434 pDb->nStmt++;
1436 /* If we have too many statement in cache, remove the surplus from
1437 ** the end of the cache list. */
1438 while( pDb->nStmt>pDb->maxStmt ){
1439 SqlPreparedStmt *pLast = pDb->stmtLast;
1440 pDb->stmtLast = pLast->pPrev;
1441 pDb->stmtLast->pNext = 0;
1442 pDb->nStmt--;
1443 dbFreeStmt(pLast);
1449 ** Structure used with dbEvalXXX() functions:
1451 ** dbEvalInit()
1452 ** dbEvalStep()
1453 ** dbEvalFinalize()
1454 ** dbEvalRowInfo()
1455 ** dbEvalColumnValue()
1457 typedef struct DbEvalContext DbEvalContext;
1458 struct DbEvalContext {
1459 SqliteDb *pDb; /* Database handle */
1460 Tcl_Obj *pSql; /* Object holding string zSql */
1461 const char *zSql; /* Remaining SQL to execute */
1462 SqlPreparedStmt *pPreStmt; /* Current statement */
1463 int nCol; /* Number of columns returned by pStmt */
1464 int evalFlags; /* Flags used */
1465 Tcl_Obj *pArray; /* Name of array variable */
1466 Tcl_Obj **apColName; /* Array of column names */
1469 #define SQLITE_EVAL_WITHOUTNULLS 0x00001 /* Unset array(*) for NULL */
1472 ** Release any cache of column names currently held as part of
1473 ** the DbEvalContext structure passed as the first argument.
1475 static void dbReleaseColumnNames(DbEvalContext *p){
1476 if( p->apColName ){
1477 int i;
1478 for(i=0; i<p->nCol; i++){
1479 Tcl_DecrRefCount(p->apColName[i]);
1481 Tcl_Free((char *)p->apColName);
1482 p->apColName = 0;
1484 p->nCol = 0;
1488 ** Initialize a DbEvalContext structure.
1490 ** If pArray is not NULL, then it contains the name of a Tcl array
1491 ** variable. The "*" member of this array is set to a list containing
1492 ** the names of the columns returned by the statement as part of each
1493 ** call to dbEvalStep(), in order from left to right. e.g. if the names
1494 ** of the returned columns are a, b and c, it does the equivalent of the
1495 ** tcl command:
1497 ** set ${pArray}(*) {a b c}
1499 static void dbEvalInit(
1500 DbEvalContext *p, /* Pointer to structure to initialize */
1501 SqliteDb *pDb, /* Database handle */
1502 Tcl_Obj *pSql, /* Object containing SQL script */
1503 Tcl_Obj *pArray, /* Name of Tcl array to set (*) element of */
1504 int evalFlags /* Flags controlling evaluation */
1506 memset(p, 0, sizeof(DbEvalContext));
1507 p->pDb = pDb;
1508 p->zSql = Tcl_GetString(pSql);
1509 p->pSql = pSql;
1510 Tcl_IncrRefCount(pSql);
1511 if( pArray ){
1512 p->pArray = pArray;
1513 Tcl_IncrRefCount(pArray);
1515 p->evalFlags = evalFlags;
1519 ** Obtain information about the row that the DbEvalContext passed as the
1520 ** first argument currently points to.
1522 static void dbEvalRowInfo(
1523 DbEvalContext *p, /* Evaluation context */
1524 int *pnCol, /* OUT: Number of column names */
1525 Tcl_Obj ***papColName /* OUT: Array of column names */
1527 /* Compute column names */
1528 if( 0==p->apColName ){
1529 sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1530 int i; /* Iterator variable */
1531 int nCol; /* Number of columns returned by pStmt */
1532 Tcl_Obj **apColName = 0; /* Array of column names */
1534 p->nCol = nCol = sqlite3_column_count(pStmt);
1535 if( nCol>0 && (papColName || p->pArray) ){
1536 apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
1537 for(i=0; i<nCol; i++){
1538 apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
1539 Tcl_IncrRefCount(apColName[i]);
1541 p->apColName = apColName;
1544 /* If results are being stored in an array variable, then create
1545 ** the array(*) entry for that array
1547 if( p->pArray ){
1548 Tcl_Interp *interp = p->pDb->interp;
1549 Tcl_Obj *pColList = Tcl_NewObj();
1550 Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
1552 for(i=0; i<nCol; i++){
1553 Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
1555 Tcl_IncrRefCount(pStar);
1556 Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
1557 Tcl_DecrRefCount(pStar);
1561 if( papColName ){
1562 *papColName = p->apColName;
1564 if( pnCol ){
1565 *pnCol = p->nCol;
1570 ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is
1571 ** returned, then an error message is stored in the interpreter before
1572 ** returning.
1574 ** A return value of TCL_OK means there is a row of data available. The
1575 ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
1576 ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK
1577 ** is returned, then the SQL script has finished executing and there are
1578 ** no further rows available. This is similar to SQLITE_DONE.
1580 static int dbEvalStep(DbEvalContext *p){
1581 const char *zPrevSql = 0; /* Previous value of p->zSql */
1583 while( p->zSql[0] || p->pPreStmt ){
1584 int rc;
1585 if( p->pPreStmt==0 ){
1586 zPrevSql = (p->zSql==zPrevSql ? 0 : p->zSql);
1587 rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
1588 if( rc!=TCL_OK ) return rc;
1589 }else{
1590 int rcs;
1591 SqliteDb *pDb = p->pDb;
1592 SqlPreparedStmt *pPreStmt = p->pPreStmt;
1593 sqlite3_stmt *pStmt = pPreStmt->pStmt;
1595 rcs = sqlite3_step(pStmt);
1596 if( rcs==SQLITE_ROW ){
1597 return TCL_OK;
1599 if( p->pArray ){
1600 dbEvalRowInfo(p, 0, 0);
1602 rcs = sqlite3_reset(pStmt);
1604 pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
1605 pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
1606 pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);
1607 pDb->nVMStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_VM_STEP,1);
1608 dbReleaseColumnNames(p);
1609 p->pPreStmt = 0;
1611 if( rcs!=SQLITE_OK ){
1612 /* If a run-time error occurs, report the error and stop reading
1613 ** the SQL. */
1614 dbReleaseStmt(pDb, pPreStmt, 1);
1615 #if SQLITE_TEST
1616 if( p->pDb->bLegacyPrepare && rcs==SQLITE_SCHEMA && zPrevSql ){
1617 /* If the runtime error was an SQLITE_SCHEMA, and the database
1618 ** handle is configured to use the legacy sqlite3_prepare()
1619 ** interface, retry prepare()/step() on the same SQL statement.
1620 ** This only happens once. If there is a second SQLITE_SCHEMA
1621 ** error, the error will be returned to the caller. */
1622 p->zSql = zPrevSql;
1623 continue;
1625 #endif
1626 Tcl_SetObjResult(pDb->interp,
1627 Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1628 return TCL_ERROR;
1629 }else{
1630 dbReleaseStmt(pDb, pPreStmt, 0);
1635 /* Finished */
1636 return TCL_BREAK;
1640 ** Free all resources currently held by the DbEvalContext structure passed
1641 ** as the first argument. There should be exactly one call to this function
1642 ** for each call to dbEvalInit().
1644 static void dbEvalFinalize(DbEvalContext *p){
1645 if( p->pPreStmt ){
1646 sqlite3_reset(p->pPreStmt->pStmt);
1647 dbReleaseStmt(p->pDb, p->pPreStmt, 0);
1648 p->pPreStmt = 0;
1650 if( p->pArray ){
1651 Tcl_DecrRefCount(p->pArray);
1652 p->pArray = 0;
1654 Tcl_DecrRefCount(p->pSql);
1655 dbReleaseColumnNames(p);
1659 ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains
1660 ** the value for the iCol'th column of the row currently pointed to by
1661 ** the DbEvalContext structure passed as the first argument.
1663 static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){
1664 sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1665 switch( sqlite3_column_type(pStmt, iCol) ){
1666 case SQLITE_BLOB: {
1667 int bytes = sqlite3_column_bytes(pStmt, iCol);
1668 const char *zBlob = sqlite3_column_blob(pStmt, iCol);
1669 if( !zBlob ) bytes = 0;
1670 return Tcl_NewByteArrayObj((u8*)zBlob, bytes);
1672 case SQLITE_INTEGER: {
1673 sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
1674 if( v>=-2147483647 && v<=2147483647 ){
1675 return Tcl_NewIntObj((int)v);
1676 }else{
1677 return Tcl_NewWideIntObj(v);
1680 case SQLITE_FLOAT: {
1681 return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
1683 case SQLITE_NULL: {
1684 return Tcl_NewStringObj(p->pDb->zNull, -1);
1688 return Tcl_NewStringObj((char*)sqlite3_column_text(pStmt, iCol), -1);
1692 ** If using Tcl version 8.6 or greater, use the NR functions to avoid
1693 ** recursive evalution of scripts by the [db eval] and [db trans]
1694 ** commands. Even if the headers used while compiling the extension
1695 ** are 8.6 or newer, the code still tests the Tcl version at runtime.
1696 ** This allows stubs-enabled builds to be used with older Tcl libraries.
1698 #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
1699 # define SQLITE_TCL_NRE 1
1700 static int DbUseNre(void){
1701 int major, minor;
1702 Tcl_GetVersion(&major, &minor, 0, 0);
1703 return( (major==8 && minor>=6) || major>8 );
1705 #else
1707 ** Compiling using headers earlier than 8.6. In this case NR cannot be
1708 ** used, so DbUseNre() to always return zero. Add #defines for the other
1709 ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
1710 ** even though the only invocations of them are within conditional blocks
1711 ** of the form:
1713 ** if( DbUseNre() ) { ... }
1715 # define SQLITE_TCL_NRE 0
1716 # define DbUseNre() 0
1717 # define Tcl_NRAddCallback(a,b,c,d,e,f) (void)0
1718 # define Tcl_NREvalObj(a,b,c) 0
1719 # define Tcl_NRCreateCommand(a,b,c,d,e,f) (void)0
1720 #endif
1723 ** This function is part of the implementation of the command:
1725 ** $db eval SQL ?ARRAYNAME? SCRIPT
1727 static int SQLITE_TCLAPI DbEvalNextCmd(
1728 ClientData data[], /* data[0] is the (DbEvalContext*) */
1729 Tcl_Interp *interp, /* Tcl interpreter */
1730 int result /* Result so far */
1732 int rc = result; /* Return code */
1734 /* The first element of the data[] array is a pointer to a DbEvalContext
1735 ** structure allocated using Tcl_Alloc(). The second element of data[]
1736 ** is a pointer to a Tcl_Obj containing the script to run for each row
1737 ** returned by the queries encapsulated in data[0]. */
1738 DbEvalContext *p = (DbEvalContext *)data[0];
1739 Tcl_Obj *pScript = (Tcl_Obj *)data[1];
1740 Tcl_Obj *pArray = p->pArray;
1742 while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
1743 int i;
1744 int nCol;
1745 Tcl_Obj **apColName;
1746 dbEvalRowInfo(p, &nCol, &apColName);
1747 for(i=0; i<nCol; i++){
1748 if( pArray==0 ){
1749 Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
1750 }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
1751 && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL
1753 Tcl_UnsetVar2(interp, Tcl_GetString(pArray),
1754 Tcl_GetString(apColName[i]), 0);
1755 }else{
1756 Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
1760 /* The required interpreter variables are now populated with the data
1761 ** from the current row. If using NRE, schedule callbacks to evaluate
1762 ** script pScript, then to invoke this function again to fetch the next
1763 ** row (or clean up if there is no next row or the script throws an
1764 ** exception). After scheduling the callbacks, return control to the
1765 ** caller.
1767 ** If not using NRE, evaluate pScript directly and continue with the
1768 ** next iteration of this while(...) loop. */
1769 if( DbUseNre() ){
1770 Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0);
1771 return Tcl_NREvalObj(interp, pScript, 0);
1772 }else{
1773 rc = Tcl_EvalObjEx(interp, pScript, 0);
1777 Tcl_DecrRefCount(pScript);
1778 dbEvalFinalize(p);
1779 Tcl_Free((char *)p);
1781 if( rc==TCL_OK || rc==TCL_BREAK ){
1782 Tcl_ResetResult(interp);
1783 rc = TCL_OK;
1785 return rc;
1789 ** This function is used by the implementations of the following database
1790 ** handle sub-commands:
1792 ** $db update_hook ?SCRIPT?
1793 ** $db wal_hook ?SCRIPT?
1794 ** $db commit_hook ?SCRIPT?
1795 ** $db preupdate hook ?SCRIPT?
1797 static void DbHookCmd(
1798 Tcl_Interp *interp, /* Tcl interpreter */
1799 SqliteDb *pDb, /* Database handle */
1800 Tcl_Obj *pArg, /* SCRIPT argument (or NULL) */
1801 Tcl_Obj **ppHook /* Pointer to member of SqliteDb */
1803 sqlite3 *db = pDb->db;
1805 if( *ppHook ){
1806 Tcl_SetObjResult(interp, *ppHook);
1807 if( pArg ){
1808 Tcl_DecrRefCount(*ppHook);
1809 *ppHook = 0;
1812 if( pArg ){
1813 assert( !(*ppHook) );
1814 if( Tcl_GetCharLength(pArg)>0 ){
1815 *ppHook = pArg;
1816 Tcl_IncrRefCount(*ppHook);
1820 #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
1821 sqlite3_preupdate_hook(db, (pDb->pPreUpdateHook?DbPreUpdateHandler:0), pDb);
1822 #endif
1823 sqlite3_update_hook(db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
1824 sqlite3_rollback_hook(db, (pDb->pRollbackHook?DbRollbackHandler:0), pDb);
1825 sqlite3_wal_hook(db, (pDb->pWalHook?DbWalHandler:0), pDb);
1829 ** The "sqlite" command below creates a new Tcl command for each
1830 ** connection it opens to an SQLite database. This routine is invoked
1831 ** whenever one of those connection-specific commands is executed
1832 ** in Tcl. For example, if you run Tcl code like this:
1834 ** sqlite3 db1 "my_database"
1835 ** db1 close
1837 ** The first command opens a connection to the "my_database" database
1838 ** and calls that connection "db1". The second command causes this
1839 ** subroutine to be invoked.
1841 static int SQLITE_TCLAPI DbObjCmd(
1842 void *cd,
1843 Tcl_Interp *interp,
1844 int objc,
1845 Tcl_Obj *const*objv
1847 SqliteDb *pDb = (SqliteDb*)cd;
1848 int choice;
1849 int rc = TCL_OK;
1850 static const char *DB_strs[] = {
1851 "authorizer", "backup", "busy",
1852 "cache", "changes", "close",
1853 "collate", "collation_needed", "commit_hook",
1854 "complete", "copy", "deserialize",
1855 "enable_load_extension", "errorcode", "eval",
1856 "exists", "function", "incrblob",
1857 "interrupt", "last_insert_rowid", "nullvalue",
1858 "onecolumn", "preupdate", "profile",
1859 "progress", "rekey", "restore",
1860 "rollback_hook", "serialize", "status",
1861 "timeout", "total_changes", "trace",
1862 "trace_v2", "transaction", "unlock_notify",
1863 "update_hook", "version", "wal_hook",
1866 enum DB_enum {
1867 DB_AUTHORIZER, DB_BACKUP, DB_BUSY,
1868 DB_CACHE, DB_CHANGES, DB_CLOSE,
1869 DB_COLLATE, DB_COLLATION_NEEDED, DB_COMMIT_HOOK,
1870 DB_COMPLETE, DB_COPY, DB_DESERIALIZE,
1871 DB_ENABLE_LOAD_EXTENSION, DB_ERRORCODE, DB_EVAL,
1872 DB_EXISTS, DB_FUNCTION, DB_INCRBLOB,
1873 DB_INTERRUPT, DB_LAST_INSERT_ROWID, DB_NULLVALUE,
1874 DB_ONECOLUMN, DB_PREUPDATE, DB_PROFILE,
1875 DB_PROGRESS, DB_REKEY, DB_RESTORE,
1876 DB_ROLLBACK_HOOK, DB_SERIALIZE, DB_STATUS,
1877 DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE,
1878 DB_TRACE_V2, DB_TRANSACTION, DB_UNLOCK_NOTIFY,
1879 DB_UPDATE_HOOK, DB_VERSION, DB_WAL_HOOK
1881 /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
1883 if( objc<2 ){
1884 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
1885 return TCL_ERROR;
1887 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
1888 return TCL_ERROR;
1891 switch( (enum DB_enum)choice ){
1893 /* $db authorizer ?CALLBACK?
1895 ** Invoke the given callback to authorize each SQL operation as it is
1896 ** compiled. 5 arguments are appended to the callback before it is
1897 ** invoked:
1899 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
1900 ** (2) First descriptive name (depends on authorization type)
1901 ** (3) Second descriptive name
1902 ** (4) Name of the database (ex: "main", "temp")
1903 ** (5) Name of trigger that is doing the access
1905 ** The callback should return on of the following strings: SQLITE_OK,
1906 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
1908 ** If this method is invoked with no arguments, the current authorization
1909 ** callback string is returned.
1911 case DB_AUTHORIZER: {
1912 #ifdef SQLITE_OMIT_AUTHORIZATION
1913 Tcl_AppendResult(interp, "authorization not available in this build",
1914 (char*)0);
1915 return TCL_ERROR;
1916 #else
1917 if( objc>3 ){
1918 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
1919 return TCL_ERROR;
1920 }else if( objc==2 ){
1921 if( pDb->zAuth ){
1922 Tcl_AppendResult(interp, pDb->zAuth, (char*)0);
1924 }else{
1925 char *zAuth;
1926 int len;
1927 if( pDb->zAuth ){
1928 Tcl_Free(pDb->zAuth);
1930 zAuth = Tcl_GetStringFromObj(objv[2], &len);
1931 if( zAuth && len>0 ){
1932 pDb->zAuth = Tcl_Alloc( len + 1 );
1933 memcpy(pDb->zAuth, zAuth, len+1);
1934 }else{
1935 pDb->zAuth = 0;
1937 if( pDb->zAuth ){
1938 typedef int (*sqlite3_auth_cb)(
1939 void*,int,const char*,const char*,
1940 const char*,const char*);
1941 pDb->interp = interp;
1942 sqlite3_set_authorizer(pDb->db,(sqlite3_auth_cb)auth_callback,pDb);
1943 }else{
1944 sqlite3_set_authorizer(pDb->db, 0, 0);
1947 #endif
1948 break;
1951 /* $db backup ?DATABASE? FILENAME
1953 ** Open or create a database file named FILENAME. Transfer the
1954 ** content of local database DATABASE (default: "main") into the
1955 ** FILENAME database.
1957 case DB_BACKUP: {
1958 const char *zDestFile;
1959 const char *zSrcDb;
1960 sqlite3 *pDest;
1961 sqlite3_backup *pBackup;
1963 if( objc==3 ){
1964 zSrcDb = "main";
1965 zDestFile = Tcl_GetString(objv[2]);
1966 }else if( objc==4 ){
1967 zSrcDb = Tcl_GetString(objv[2]);
1968 zDestFile = Tcl_GetString(objv[3]);
1969 }else{
1970 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
1971 return TCL_ERROR;
1973 rc = sqlite3_open_v2(zDestFile, &pDest,
1974 SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE| pDb->openFlags, 0);
1975 if( rc!=SQLITE_OK ){
1976 Tcl_AppendResult(interp, "cannot open target database: ",
1977 sqlite3_errmsg(pDest), (char*)0);
1978 sqlite3_close(pDest);
1979 return TCL_ERROR;
1981 pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
1982 if( pBackup==0 ){
1983 Tcl_AppendResult(interp, "backup failed: ",
1984 sqlite3_errmsg(pDest), (char*)0);
1985 sqlite3_close(pDest);
1986 return TCL_ERROR;
1988 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
1989 sqlite3_backup_finish(pBackup);
1990 if( rc==SQLITE_DONE ){
1991 rc = TCL_OK;
1992 }else{
1993 Tcl_AppendResult(interp, "backup failed: ",
1994 sqlite3_errmsg(pDest), (char*)0);
1995 rc = TCL_ERROR;
1997 sqlite3_close(pDest);
1998 break;
2001 /* $db busy ?CALLBACK?
2003 ** Invoke the given callback if an SQL statement attempts to open
2004 ** a locked database file.
2006 case DB_BUSY: {
2007 if( objc>3 ){
2008 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
2009 return TCL_ERROR;
2010 }else if( objc==2 ){
2011 if( pDb->zBusy ){
2012 Tcl_AppendResult(interp, pDb->zBusy, (char*)0);
2014 }else{
2015 char *zBusy;
2016 int len;
2017 if( pDb->zBusy ){
2018 Tcl_Free(pDb->zBusy);
2020 zBusy = Tcl_GetStringFromObj(objv[2], &len);
2021 if( zBusy && len>0 ){
2022 pDb->zBusy = Tcl_Alloc( len + 1 );
2023 memcpy(pDb->zBusy, zBusy, len+1);
2024 }else{
2025 pDb->zBusy = 0;
2027 if( pDb->zBusy ){
2028 pDb->interp = interp;
2029 sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
2030 }else{
2031 sqlite3_busy_handler(pDb->db, 0, 0);
2034 break;
2037 /* $db cache flush
2038 ** $db cache size n
2040 ** Flush the prepared statement cache, or set the maximum number of
2041 ** cached statements.
2043 case DB_CACHE: {
2044 char *subCmd;
2045 int n;
2047 if( objc<=2 ){
2048 Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
2049 return TCL_ERROR;
2051 subCmd = Tcl_GetStringFromObj( objv[2], 0 );
2052 if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
2053 if( objc!=3 ){
2054 Tcl_WrongNumArgs(interp, 2, objv, "flush");
2055 return TCL_ERROR;
2056 }else{
2057 flushStmtCache( pDb );
2059 }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
2060 if( objc!=4 ){
2061 Tcl_WrongNumArgs(interp, 2, objv, "size n");
2062 return TCL_ERROR;
2063 }else{
2064 if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
2065 Tcl_AppendResult( interp, "cannot convert \"",
2066 Tcl_GetStringFromObj(objv[3],0), "\" to integer", (char*)0);
2067 return TCL_ERROR;
2068 }else{
2069 if( n<0 ){
2070 flushStmtCache( pDb );
2071 n = 0;
2072 }else if( n>MAX_PREPARED_STMTS ){
2073 n = MAX_PREPARED_STMTS;
2075 pDb->maxStmt = n;
2078 }else{
2079 Tcl_AppendResult( interp, "bad option \"",
2080 Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size",
2081 (char*)0);
2082 return TCL_ERROR;
2084 break;
2087 /* $db changes
2089 ** Return the number of rows that were modified, inserted, or deleted by
2090 ** the most recent INSERT, UPDATE or DELETE statement, not including
2091 ** any changes made by trigger programs.
2093 case DB_CHANGES: {
2094 Tcl_Obj *pResult;
2095 if( objc!=2 ){
2096 Tcl_WrongNumArgs(interp, 2, objv, "");
2097 return TCL_ERROR;
2099 pResult = Tcl_GetObjResult(interp);
2100 Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
2101 break;
2104 /* $db close
2106 ** Shutdown the database
2108 case DB_CLOSE: {
2109 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
2110 break;
2114 ** $db collate NAME SCRIPT
2116 ** Create a new SQL collation function called NAME. Whenever
2117 ** that function is called, invoke SCRIPT to evaluate the function.
2119 case DB_COLLATE: {
2120 SqlCollate *pCollate;
2121 char *zName;
2122 char *zScript;
2123 int nScript;
2124 if( objc!=4 ){
2125 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
2126 return TCL_ERROR;
2128 zName = Tcl_GetStringFromObj(objv[2], 0);
2129 zScript = Tcl_GetStringFromObj(objv[3], &nScript);
2130 pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
2131 if( pCollate==0 ) return TCL_ERROR;
2132 pCollate->interp = interp;
2133 pCollate->pNext = pDb->pCollate;
2134 pCollate->zScript = (char*)&pCollate[1];
2135 pDb->pCollate = pCollate;
2136 memcpy(pCollate->zScript, zScript, nScript+1);
2137 if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
2138 pCollate, tclSqlCollate) ){
2139 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
2140 return TCL_ERROR;
2142 break;
2146 ** $db collation_needed SCRIPT
2148 ** Create a new SQL collation function called NAME. Whenever
2149 ** that function is called, invoke SCRIPT to evaluate the function.
2151 case DB_COLLATION_NEEDED: {
2152 if( objc!=3 ){
2153 Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
2154 return TCL_ERROR;
2156 if( pDb->pCollateNeeded ){
2157 Tcl_DecrRefCount(pDb->pCollateNeeded);
2159 pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
2160 Tcl_IncrRefCount(pDb->pCollateNeeded);
2161 sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
2162 break;
2165 /* $db commit_hook ?CALLBACK?
2167 ** Invoke the given callback just before committing every SQL transaction.
2168 ** If the callback throws an exception or returns non-zero, then the
2169 ** transaction is aborted. If CALLBACK is an empty string, the callback
2170 ** is disabled.
2172 case DB_COMMIT_HOOK: {
2173 if( objc>3 ){
2174 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2175 return TCL_ERROR;
2176 }else if( objc==2 ){
2177 if( pDb->zCommit ){
2178 Tcl_AppendResult(interp, pDb->zCommit, (char*)0);
2180 }else{
2181 const char *zCommit;
2182 int len;
2183 if( pDb->zCommit ){
2184 Tcl_Free(pDb->zCommit);
2186 zCommit = Tcl_GetStringFromObj(objv[2], &len);
2187 if( zCommit && len>0 ){
2188 pDb->zCommit = Tcl_Alloc( len + 1 );
2189 memcpy(pDb->zCommit, zCommit, len+1);
2190 }else{
2191 pDb->zCommit = 0;
2193 if( pDb->zCommit ){
2194 pDb->interp = interp;
2195 sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
2196 }else{
2197 sqlite3_commit_hook(pDb->db, 0, 0);
2200 break;
2203 /* $db complete SQL
2205 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
2206 ** additional lines of input are needed. This is similar to the
2207 ** built-in "info complete" command of Tcl.
2209 case DB_COMPLETE: {
2210 #ifndef SQLITE_OMIT_COMPLETE
2211 Tcl_Obj *pResult;
2212 int isComplete;
2213 if( objc!=3 ){
2214 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
2215 return TCL_ERROR;
2217 isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
2218 pResult = Tcl_GetObjResult(interp);
2219 Tcl_SetBooleanObj(pResult, isComplete);
2220 #endif
2221 break;
2224 /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
2226 ** Copy data into table from filename, optionally using SEPARATOR
2227 ** as column separators. If a column contains a null string, or the
2228 ** value of NULLINDICATOR, a NULL is inserted for the column.
2229 ** conflict-algorithm is one of the sqlite conflict algorithms:
2230 ** rollback, abort, fail, ignore, replace
2231 ** On success, return the number of lines processed, not necessarily same
2232 ** as 'db changes' due to conflict-algorithm selected.
2234 ** This code is basically an implementation/enhancement of
2235 ** the sqlite3 shell.c ".import" command.
2237 ** This command usage is equivalent to the sqlite2.x COPY statement,
2238 ** which imports file data into a table using the PostgreSQL COPY file format:
2239 ** $db copy $conflit_algo $table_name $filename \t \\N
2241 case DB_COPY: {
2242 char *zTable; /* Insert data into this table */
2243 char *zFile; /* The file from which to extract data */
2244 char *zConflict; /* The conflict algorithm to use */
2245 sqlite3_stmt *pStmt; /* A statement */
2246 int nCol; /* Number of columns in the table */
2247 int nByte; /* Number of bytes in an SQL string */
2248 int i, j; /* Loop counters */
2249 int nSep; /* Number of bytes in zSep[] */
2250 int nNull; /* Number of bytes in zNull[] */
2251 char *zSql; /* An SQL statement */
2252 char *zLine; /* A single line of input from the file */
2253 char **azCol; /* zLine[] broken up into columns */
2254 const char *zCommit; /* How to commit changes */
2255 FILE *in; /* The input file */
2256 int lineno = 0; /* Line number of input file */
2257 char zLineNum[80]; /* Line number print buffer */
2258 Tcl_Obj *pResult; /* interp result */
2260 const char *zSep;
2261 const char *zNull;
2262 if( objc<5 || objc>7 ){
2263 Tcl_WrongNumArgs(interp, 2, objv,
2264 "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
2265 return TCL_ERROR;
2267 if( objc>=6 ){
2268 zSep = Tcl_GetStringFromObj(objv[5], 0);
2269 }else{
2270 zSep = "\t";
2272 if( objc>=7 ){
2273 zNull = Tcl_GetStringFromObj(objv[6], 0);
2274 }else{
2275 zNull = "";
2277 zConflict = Tcl_GetStringFromObj(objv[2], 0);
2278 zTable = Tcl_GetStringFromObj(objv[3], 0);
2279 zFile = Tcl_GetStringFromObj(objv[4], 0);
2280 nSep = strlen30(zSep);
2281 nNull = strlen30(zNull);
2282 if( nSep==0 ){
2283 Tcl_AppendResult(interp,"Error: non-null separator required for copy",
2284 (char*)0);
2285 return TCL_ERROR;
2287 if(strcmp(zConflict, "rollback") != 0 &&
2288 strcmp(zConflict, "abort" ) != 0 &&
2289 strcmp(zConflict, "fail" ) != 0 &&
2290 strcmp(zConflict, "ignore" ) != 0 &&
2291 strcmp(zConflict, "replace" ) != 0 ) {
2292 Tcl_AppendResult(interp, "Error: \"", zConflict,
2293 "\", conflict-algorithm must be one of: rollback, "
2294 "abort, fail, ignore, or replace", (char*)0);
2295 return TCL_ERROR;
2297 zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
2298 if( zSql==0 ){
2299 Tcl_AppendResult(interp, "Error: no such table: ", zTable, (char*)0);
2300 return TCL_ERROR;
2302 nByte = strlen30(zSql);
2303 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
2304 sqlite3_free(zSql);
2305 if( rc ){
2306 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2307 nCol = 0;
2308 }else{
2309 nCol = sqlite3_column_count(pStmt);
2311 sqlite3_finalize(pStmt);
2312 if( nCol==0 ) {
2313 return TCL_ERROR;
2315 zSql = malloc( nByte + 50 + nCol*2 );
2316 if( zSql==0 ) {
2317 Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
2318 return TCL_ERROR;
2320 sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
2321 zConflict, zTable);
2322 j = strlen30(zSql);
2323 for(i=1; i<nCol; i++){
2324 zSql[j++] = ',';
2325 zSql[j++] = '?';
2327 zSql[j++] = ')';
2328 zSql[j] = 0;
2329 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
2330 free(zSql);
2331 if( rc ){
2332 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2333 sqlite3_finalize(pStmt);
2334 return TCL_ERROR;
2336 in = fopen(zFile, "rb");
2337 if( in==0 ){
2338 Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, (char*)0);
2339 sqlite3_finalize(pStmt);
2340 return TCL_ERROR;
2342 azCol = malloc( sizeof(azCol[0])*(nCol+1) );
2343 if( azCol==0 ) {
2344 Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
2345 fclose(in);
2346 return TCL_ERROR;
2348 (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
2349 zCommit = "COMMIT";
2350 while( (zLine = local_getline(0, in))!=0 ){
2351 char *z;
2352 lineno++;
2353 azCol[0] = zLine;
2354 for(i=0, z=zLine; *z; z++){
2355 if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
2356 *z = 0;
2357 i++;
2358 if( i<nCol ){
2359 azCol[i] = &z[nSep];
2360 z += nSep-1;
2364 if( i+1!=nCol ){
2365 char *zErr;
2366 int nErr = strlen30(zFile) + 200;
2367 zErr = malloc(nErr);
2368 if( zErr ){
2369 sqlite3_snprintf(nErr, zErr,
2370 "Error: %s line %d: expected %d columns of data but found %d",
2371 zFile, lineno, nCol, i+1);
2372 Tcl_AppendResult(interp, zErr, (char*)0);
2373 free(zErr);
2375 zCommit = "ROLLBACK";
2376 break;
2378 for(i=0; i<nCol; i++){
2379 /* check for null data, if so, bind as null */
2380 if( (nNull>0 && strcmp(azCol[i], zNull)==0)
2381 || strlen30(azCol[i])==0
2383 sqlite3_bind_null(pStmt, i+1);
2384 }else{
2385 sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
2388 sqlite3_step(pStmt);
2389 rc = sqlite3_reset(pStmt);
2390 free(zLine);
2391 if( rc!=SQLITE_OK ){
2392 Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2393 zCommit = "ROLLBACK";
2394 break;
2397 free(azCol);
2398 fclose(in);
2399 sqlite3_finalize(pStmt);
2400 (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
2402 if( zCommit[0] == 'C' ){
2403 /* success, set result as number of lines processed */
2404 pResult = Tcl_GetObjResult(interp);
2405 Tcl_SetIntObj(pResult, lineno);
2406 rc = TCL_OK;
2407 }else{
2408 /* failure, append lineno where failed */
2409 sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
2410 Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,
2411 (char*)0);
2412 rc = TCL_ERROR;
2414 break;
2418 ** $db deserialize ?DATABASE? VALUE
2420 ** Reopen DATABASE (default "main") using the content in $VALUE
2422 case DB_DESERIALIZE: {
2423 #ifndef SQLITE_ENABLE_DESERIALIZE
2424 Tcl_AppendResult(interp, "MEMDB not available in this build",
2425 (char*)0);
2426 rc = TCL_ERROR;
2427 #else
2428 const char *zSchema;
2429 Tcl_Obj *pValue;
2430 unsigned char *pBA;
2431 unsigned char *pData;
2432 int len, xrc;
2434 if( objc==3 ){
2435 zSchema = 0;
2436 pValue = objv[2];
2437 }else if( objc==4 ){
2438 zSchema = Tcl_GetString(objv[2]);
2439 pValue = objv[3];
2440 }else{
2441 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? VALUE");
2442 rc = TCL_ERROR;
2443 break;
2445 pBA = Tcl_GetByteArrayFromObj(pValue, &len);
2446 pData = sqlite3_malloc64( len );
2447 if( pData==0 && len>0 ){
2448 Tcl_AppendResult(interp, "out of memory", (char*)0);
2449 rc = TCL_ERROR;
2450 }else{
2451 if( len>0 ) memcpy(pData, pBA, len);
2452 xrc = sqlite3_deserialize(pDb->db, zSchema, pData, len, len,
2453 SQLITE_DESERIALIZE_FREEONCLOSE |
2454 SQLITE_DESERIALIZE_RESIZEABLE);
2455 if( xrc ){
2456 Tcl_AppendResult(interp, "unable to set MEMDB content", (char*)0);
2457 rc = TCL_ERROR;
2460 #endif
2461 break;
2465 ** $db enable_load_extension BOOLEAN
2467 ** Turn the extension loading feature on or off. It if off by
2468 ** default.
2470 case DB_ENABLE_LOAD_EXTENSION: {
2471 #ifndef SQLITE_OMIT_LOAD_EXTENSION
2472 int onoff;
2473 if( objc!=3 ){
2474 Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
2475 return TCL_ERROR;
2477 if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
2478 return TCL_ERROR;
2480 sqlite3_enable_load_extension(pDb->db, onoff);
2481 break;
2482 #else
2483 Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
2484 (char*)0);
2485 return TCL_ERROR;
2486 #endif
2490 ** $db errorcode
2492 ** Return the numeric error code that was returned by the most recent
2493 ** call to sqlite3_exec().
2495 case DB_ERRORCODE: {
2496 Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
2497 break;
2501 ** $db exists $sql
2502 ** $db onecolumn $sql
2504 ** The onecolumn method is the equivalent of:
2505 ** lindex [$db eval $sql] 0
2507 case DB_EXISTS:
2508 case DB_ONECOLUMN: {
2509 Tcl_Obj *pResult = 0;
2510 DbEvalContext sEval;
2511 if( objc!=3 ){
2512 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
2513 return TCL_ERROR;
2516 dbEvalInit(&sEval, pDb, objv[2], 0, 0);
2517 rc = dbEvalStep(&sEval);
2518 if( choice==DB_ONECOLUMN ){
2519 if( rc==TCL_OK ){
2520 pResult = dbEvalColumnValue(&sEval, 0);
2521 }else if( rc==TCL_BREAK ){
2522 Tcl_ResetResult(interp);
2524 }else if( rc==TCL_BREAK || rc==TCL_OK ){
2525 pResult = Tcl_NewBooleanObj(rc==TCL_OK);
2527 dbEvalFinalize(&sEval);
2528 if( pResult ) Tcl_SetObjResult(interp, pResult);
2530 if( rc==TCL_BREAK ){
2531 rc = TCL_OK;
2533 break;
2537 ** $db eval ?options? $sql ?array? ?{ ...code... }?
2539 ** The SQL statement in $sql is evaluated. For each row, the values are
2540 ** placed in elements of the array named "array" and ...code... is executed.
2541 ** If "array" and "code" are omitted, then no callback is every invoked.
2542 ** If "array" is an empty string, then the values are placed in variables
2543 ** that have the same name as the fields extracted by the query.
2545 case DB_EVAL: {
2546 int evalFlags = 0;
2547 const char *zOpt;
2548 while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
2549 if( strcmp(zOpt, "-withoutnulls")==0 ){
2550 evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
2552 else{
2553 Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
2554 return TCL_ERROR;
2556 objc--;
2557 objv++;
2559 if( objc<3 || objc>5 ){
2560 Tcl_WrongNumArgs(interp, 2, objv,
2561 "?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?");
2562 return TCL_ERROR;
2565 if( objc==3 ){
2566 DbEvalContext sEval;
2567 Tcl_Obj *pRet = Tcl_NewObj();
2568 Tcl_IncrRefCount(pRet);
2569 dbEvalInit(&sEval, pDb, objv[2], 0, 0);
2570 while( TCL_OK==(rc = dbEvalStep(&sEval)) ){
2571 int i;
2572 int nCol;
2573 dbEvalRowInfo(&sEval, &nCol, 0);
2574 for(i=0; i<nCol; i++){
2575 Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
2578 dbEvalFinalize(&sEval);
2579 if( rc==TCL_BREAK ){
2580 Tcl_SetObjResult(interp, pRet);
2581 rc = TCL_OK;
2583 Tcl_DecrRefCount(pRet);
2584 }else{
2585 ClientData cd2[2];
2586 DbEvalContext *p;
2587 Tcl_Obj *pArray = 0;
2588 Tcl_Obj *pScript;
2590 if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
2591 pArray = objv[3];
2593 pScript = objv[objc-1];
2594 Tcl_IncrRefCount(pScript);
2596 p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
2597 dbEvalInit(p, pDb, objv[2], pArray, evalFlags);
2599 cd2[0] = (void *)p;
2600 cd2[1] = (void *)pScript;
2601 rc = DbEvalNextCmd(cd2, interp, TCL_OK);
2603 break;
2607 ** $db function NAME [-argcount N] [-deterministic] SCRIPT
2609 ** Create a new SQL function called NAME. Whenever that function is
2610 ** called, invoke SCRIPT to evaluate the function.
2612 case DB_FUNCTION: {
2613 int flags = SQLITE_UTF8;
2614 SqlFunc *pFunc;
2615 Tcl_Obj *pScript;
2616 char *zName;
2617 int nArg = -1;
2618 int i;
2619 if( objc<4 ){
2620 Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT");
2621 return TCL_ERROR;
2623 for(i=3; i<(objc-1); i++){
2624 const char *z = Tcl_GetString(objv[i]);
2625 int n = strlen30(z);
2626 if( n>2 && strncmp(z, "-argcount",n)==0 ){
2627 if( i==(objc-2) ){
2628 Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
2629 return TCL_ERROR;
2631 if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR;
2632 if( nArg<0 ){
2633 Tcl_AppendResult(interp, "number of arguments must be non-negative",
2634 (char*)0);
2635 return TCL_ERROR;
2637 i++;
2638 }else
2639 if( n>2 && strncmp(z, "-deterministic",n)==0 ){
2640 flags |= SQLITE_DETERMINISTIC;
2641 }else{
2642 Tcl_AppendResult(interp, "bad option \"", z,
2643 "\": must be -argcount or -deterministic", (char*)0
2645 return TCL_ERROR;
2649 pScript = objv[objc-1];
2650 zName = Tcl_GetStringFromObj(objv[2], 0);
2651 pFunc = findSqlFunc(pDb, zName);
2652 if( pFunc==0 ) return TCL_ERROR;
2653 if( pFunc->pScript ){
2654 Tcl_DecrRefCount(pFunc->pScript);
2656 pFunc->pScript = pScript;
2657 Tcl_IncrRefCount(pScript);
2658 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
2659 rc = sqlite3_create_function(pDb->db, zName, nArg, flags,
2660 pFunc, tclSqlFunc, 0, 0);
2661 if( rc!=SQLITE_OK ){
2662 rc = TCL_ERROR;
2663 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
2665 break;
2669 ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
2671 case DB_INCRBLOB: {
2672 #ifdef SQLITE_OMIT_INCRBLOB
2673 Tcl_AppendResult(interp, "incrblob not available in this build", (char*)0);
2674 return TCL_ERROR;
2675 #else
2676 int isReadonly = 0;
2677 const char *zDb = "main";
2678 const char *zTable;
2679 const char *zColumn;
2680 Tcl_WideInt iRow;
2682 /* Check for the -readonly option */
2683 if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
2684 isReadonly = 1;
2687 if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
2688 Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
2689 return TCL_ERROR;
2692 if( objc==(6+isReadonly) ){
2693 zDb = Tcl_GetString(objv[2]);
2695 zTable = Tcl_GetString(objv[objc-3]);
2696 zColumn = Tcl_GetString(objv[objc-2]);
2697 rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
2699 if( rc==TCL_OK ){
2700 rc = createIncrblobChannel(
2701 interp, pDb, zDb, zTable, zColumn, (sqlite3_int64)iRow, isReadonly
2704 #endif
2705 break;
2709 ** $db interrupt
2711 ** Interrupt the execution of the inner-most SQL interpreter. This
2712 ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
2714 case DB_INTERRUPT: {
2715 sqlite3_interrupt(pDb->db);
2716 break;
2720 ** $db nullvalue ?STRING?
2722 ** Change text used when a NULL comes back from the database. If ?STRING?
2723 ** is not present, then the current string used for NULL is returned.
2724 ** If STRING is present, then STRING is returned.
2727 case DB_NULLVALUE: {
2728 if( objc!=2 && objc!=3 ){
2729 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
2730 return TCL_ERROR;
2732 if( objc==3 ){
2733 int len;
2734 char *zNull = Tcl_GetStringFromObj(objv[2], &len);
2735 if( pDb->zNull ){
2736 Tcl_Free(pDb->zNull);
2738 if( zNull && len>0 ){
2739 pDb->zNull = Tcl_Alloc( len + 1 );
2740 memcpy(pDb->zNull, zNull, len);
2741 pDb->zNull[len] = '\0';
2742 }else{
2743 pDb->zNull = 0;
2746 Tcl_SetObjResult(interp, Tcl_NewStringObj(pDb->zNull, -1));
2747 break;
2751 ** $db last_insert_rowid
2753 ** Return an integer which is the ROWID for the most recent insert.
2755 case DB_LAST_INSERT_ROWID: {
2756 Tcl_Obj *pResult;
2757 Tcl_WideInt rowid;
2758 if( objc!=2 ){
2759 Tcl_WrongNumArgs(interp, 2, objv, "");
2760 return TCL_ERROR;
2762 rowid = sqlite3_last_insert_rowid(pDb->db);
2763 pResult = Tcl_GetObjResult(interp);
2764 Tcl_SetWideIntObj(pResult, rowid);
2765 break;
2769 ** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
2772 /* $db progress ?N CALLBACK?
2774 ** Invoke the given callback every N virtual machine opcodes while executing
2775 ** queries.
2777 case DB_PROGRESS: {
2778 if( objc==2 ){
2779 if( pDb->zProgress ){
2780 Tcl_AppendResult(interp, pDb->zProgress, (char*)0);
2782 }else if( objc==4 ){
2783 char *zProgress;
2784 int len;
2785 int N;
2786 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
2787 return TCL_ERROR;
2789 if( pDb->zProgress ){
2790 Tcl_Free(pDb->zProgress);
2792 zProgress = Tcl_GetStringFromObj(objv[3], &len);
2793 if( zProgress && len>0 ){
2794 pDb->zProgress = Tcl_Alloc( len + 1 );
2795 memcpy(pDb->zProgress, zProgress, len+1);
2796 }else{
2797 pDb->zProgress = 0;
2799 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
2800 if( pDb->zProgress ){
2801 pDb->interp = interp;
2802 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
2803 }else{
2804 sqlite3_progress_handler(pDb->db, 0, 0, 0);
2806 #endif
2807 }else{
2808 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
2809 return TCL_ERROR;
2811 break;
2814 /* $db profile ?CALLBACK?
2816 ** Make arrangements to invoke the CALLBACK routine after each SQL statement
2817 ** that has run. The text of the SQL and the amount of elapse time are
2818 ** appended to CALLBACK before the script is run.
2820 case DB_PROFILE: {
2821 if( objc>3 ){
2822 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2823 return TCL_ERROR;
2824 }else if( objc==2 ){
2825 if( pDb->zProfile ){
2826 Tcl_AppendResult(interp, pDb->zProfile, (char*)0);
2828 }else{
2829 char *zProfile;
2830 int len;
2831 if( pDb->zProfile ){
2832 Tcl_Free(pDb->zProfile);
2834 zProfile = Tcl_GetStringFromObj(objv[2], &len);
2835 if( zProfile && len>0 ){
2836 pDb->zProfile = Tcl_Alloc( len + 1 );
2837 memcpy(pDb->zProfile, zProfile, len+1);
2838 }else{
2839 pDb->zProfile = 0;
2841 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
2842 !defined(SQLITE_OMIT_DEPRECATED)
2843 if( pDb->zProfile ){
2844 pDb->interp = interp;
2845 sqlite3_profile(pDb->db, DbProfileHandler, pDb);
2846 }else{
2847 sqlite3_profile(pDb->db, 0, 0);
2849 #endif
2851 break;
2855 ** $db rekey KEY
2857 ** Change the encryption key on the currently open database.
2859 case DB_REKEY: {
2860 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
2861 int nKey;
2862 void *pKey;
2863 #endif
2864 if( objc!=3 ){
2865 Tcl_WrongNumArgs(interp, 2, objv, "KEY");
2866 return TCL_ERROR;
2868 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
2869 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
2870 rc = sqlite3_rekey(pDb->db, pKey, nKey);
2871 if( rc ){
2872 Tcl_AppendResult(interp, sqlite3_errstr(rc), (char*)0);
2873 rc = TCL_ERROR;
2875 #endif
2876 break;
2879 /* $db restore ?DATABASE? FILENAME
2881 ** Open a database file named FILENAME. Transfer the content
2882 ** of FILENAME into the local database DATABASE (default: "main").
2884 case DB_RESTORE: {
2885 const char *zSrcFile;
2886 const char *zDestDb;
2887 sqlite3 *pSrc;
2888 sqlite3_backup *pBackup;
2889 int nTimeout = 0;
2891 if( objc==3 ){
2892 zDestDb = "main";
2893 zSrcFile = Tcl_GetString(objv[2]);
2894 }else if( objc==4 ){
2895 zDestDb = Tcl_GetString(objv[2]);
2896 zSrcFile = Tcl_GetString(objv[3]);
2897 }else{
2898 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
2899 return TCL_ERROR;
2901 rc = sqlite3_open_v2(zSrcFile, &pSrc,
2902 SQLITE_OPEN_READONLY | pDb->openFlags, 0);
2903 if( rc!=SQLITE_OK ){
2904 Tcl_AppendResult(interp, "cannot open source database: ",
2905 sqlite3_errmsg(pSrc), (char*)0);
2906 sqlite3_close(pSrc);
2907 return TCL_ERROR;
2909 pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
2910 if( pBackup==0 ){
2911 Tcl_AppendResult(interp, "restore failed: ",
2912 sqlite3_errmsg(pDb->db), (char*)0);
2913 sqlite3_close(pSrc);
2914 return TCL_ERROR;
2916 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
2917 || rc==SQLITE_BUSY ){
2918 if( rc==SQLITE_BUSY ){
2919 if( nTimeout++ >= 3 ) break;
2920 sqlite3_sleep(100);
2923 sqlite3_backup_finish(pBackup);
2924 if( rc==SQLITE_DONE ){
2925 rc = TCL_OK;
2926 }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){
2927 Tcl_AppendResult(interp, "restore failed: source database busy",
2928 (char*)0);
2929 rc = TCL_ERROR;
2930 }else{
2931 Tcl_AppendResult(interp, "restore failed: ",
2932 sqlite3_errmsg(pDb->db), (char*)0);
2933 rc = TCL_ERROR;
2935 sqlite3_close(pSrc);
2936 break;
2940 ** $db serialize ?DATABASE?
2942 ** Return a serialization of a database.
2944 case DB_SERIALIZE: {
2945 #ifndef SQLITE_ENABLE_DESERIALIZE
2946 Tcl_AppendResult(interp, "MEMDB not available in this build",
2947 (char*)0);
2948 rc = TCL_ERROR;
2949 #else
2950 const char *zSchema = objc>=3 ? Tcl_GetString(objv[2]) : "main";
2951 sqlite3_int64 sz = 0;
2952 unsigned char *pData;
2953 if( objc!=2 && objc!=3 ){
2954 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE?");
2955 rc = TCL_ERROR;
2956 }else{
2957 int needFree;
2958 pData = sqlite3_serialize(pDb->db, zSchema, &sz, SQLITE_SERIALIZE_NOCOPY);
2959 if( pData ){
2960 needFree = 0;
2961 }else{
2962 pData = sqlite3_serialize(pDb->db, zSchema, &sz, 0);
2963 needFree = 1;
2965 Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(pData,sz));
2966 if( needFree ) sqlite3_free(pData);
2968 #endif
2969 break;
2973 ** $db status (step|sort|autoindex|vmstep)
2975 ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
2976 ** SQLITE_STMTSTATUS_SORT for the most recent eval.
2978 case DB_STATUS: {
2979 int v;
2980 const char *zOp;
2981 if( objc!=3 ){
2982 Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)");
2983 return TCL_ERROR;
2985 zOp = Tcl_GetString(objv[2]);
2986 if( strcmp(zOp, "step")==0 ){
2987 v = pDb->nStep;
2988 }else if( strcmp(zOp, "sort")==0 ){
2989 v = pDb->nSort;
2990 }else if( strcmp(zOp, "autoindex")==0 ){
2991 v = pDb->nIndex;
2992 }else if( strcmp(zOp, "vmstep")==0 ){
2993 v = pDb->nVMStep;
2994 }else{
2995 Tcl_AppendResult(interp,
2996 "bad argument: should be autoindex, step, sort or vmstep",
2997 (char*)0);
2998 return TCL_ERROR;
3000 Tcl_SetObjResult(interp, Tcl_NewIntObj(v));
3001 break;
3005 ** $db timeout MILLESECONDS
3007 ** Delay for the number of milliseconds specified when a file is locked.
3009 case DB_TIMEOUT: {
3010 int ms;
3011 if( objc!=3 ){
3012 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
3013 return TCL_ERROR;
3015 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
3016 sqlite3_busy_timeout(pDb->db, ms);
3017 break;
3021 ** $db total_changes
3023 ** Return the number of rows that were modified, inserted, or deleted
3024 ** since the database handle was created.
3026 case DB_TOTAL_CHANGES: {
3027 Tcl_Obj *pResult;
3028 if( objc!=2 ){
3029 Tcl_WrongNumArgs(interp, 2, objv, "");
3030 return TCL_ERROR;
3032 pResult = Tcl_GetObjResult(interp);
3033 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
3034 break;
3037 /* $db trace ?CALLBACK?
3039 ** Make arrangements to invoke the CALLBACK routine for each SQL statement
3040 ** that is executed. The text of the SQL is appended to CALLBACK before
3041 ** it is executed.
3043 case DB_TRACE: {
3044 if( objc>3 ){
3045 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
3046 return TCL_ERROR;
3047 }else if( objc==2 ){
3048 if( pDb->zTrace ){
3049 Tcl_AppendResult(interp, pDb->zTrace, (char*)0);
3051 }else{
3052 char *zTrace;
3053 int len;
3054 if( pDb->zTrace ){
3055 Tcl_Free(pDb->zTrace);
3057 zTrace = Tcl_GetStringFromObj(objv[2], &len);
3058 if( zTrace && len>0 ){
3059 pDb->zTrace = Tcl_Alloc( len + 1 );
3060 memcpy(pDb->zTrace, zTrace, len+1);
3061 }else{
3062 pDb->zTrace = 0;
3064 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
3065 !defined(SQLITE_OMIT_DEPRECATED)
3066 if( pDb->zTrace ){
3067 pDb->interp = interp;
3068 sqlite3_trace(pDb->db, DbTraceHandler, pDb);
3069 }else{
3070 sqlite3_trace(pDb->db, 0, 0);
3072 #endif
3074 break;
3077 /* $db trace_v2 ?CALLBACK? ?MASK?
3079 ** Make arrangements to invoke the CALLBACK routine for each trace event
3080 ** matching the mask that is generated. The parameters are appended to
3081 ** CALLBACK before it is executed.
3083 case DB_TRACE_V2: {
3084 if( objc>4 ){
3085 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK? ?MASK?");
3086 return TCL_ERROR;
3087 }else if( objc==2 ){
3088 if( pDb->zTraceV2 ){
3089 Tcl_AppendResult(interp, pDb->zTraceV2, (char*)0);
3091 }else{
3092 char *zTraceV2;
3093 int len;
3094 Tcl_WideInt wMask = 0;
3095 if( objc==4 ){
3096 static const char *TTYPE_strs[] = {
3097 "statement", "profile", "row", "close", 0
3099 enum TTYPE_enum {
3100 TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE
3102 int i;
3103 if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){
3104 return TCL_ERROR;
3106 for(i=0; i<len; i++){
3107 Tcl_Obj *pObj;
3108 int ttype;
3109 if( TCL_OK!=Tcl_ListObjIndex(interp, objv[3], i, &pObj) ){
3110 return TCL_ERROR;
3112 if( Tcl_GetIndexFromObj(interp, pObj, TTYPE_strs, "trace type",
3113 0, &ttype)!=TCL_OK ){
3114 Tcl_WideInt wType;
3115 Tcl_Obj *pError = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
3116 Tcl_IncrRefCount(pError);
3117 if( TCL_OK==Tcl_GetWideIntFromObj(interp, pObj, &wType) ){
3118 Tcl_DecrRefCount(pError);
3119 wMask |= wType;
3120 }else{
3121 Tcl_SetObjResult(interp, pError);
3122 Tcl_DecrRefCount(pError);
3123 return TCL_ERROR;
3125 }else{
3126 switch( (enum TTYPE_enum)ttype ){
3127 case TTYPE_STMT: wMask |= SQLITE_TRACE_STMT; break;
3128 case TTYPE_PROFILE: wMask |= SQLITE_TRACE_PROFILE; break;
3129 case TTYPE_ROW: wMask |= SQLITE_TRACE_ROW; break;
3130 case TTYPE_CLOSE: wMask |= SQLITE_TRACE_CLOSE; break;
3134 }else{
3135 wMask = SQLITE_TRACE_STMT; /* use the "legacy" default */
3137 if( pDb->zTraceV2 ){
3138 Tcl_Free(pDb->zTraceV2);
3140 zTraceV2 = Tcl_GetStringFromObj(objv[2], &len);
3141 if( zTraceV2 && len>0 ){
3142 pDb->zTraceV2 = Tcl_Alloc( len + 1 );
3143 memcpy(pDb->zTraceV2, zTraceV2, len+1);
3144 }else{
3145 pDb->zTraceV2 = 0;
3147 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
3148 if( pDb->zTraceV2 ){
3149 pDb->interp = interp;
3150 sqlite3_trace_v2(pDb->db, (unsigned)wMask, DbTraceV2Handler, pDb);
3151 }else{
3152 sqlite3_trace_v2(pDb->db, 0, 0, 0);
3154 #endif
3156 break;
3159 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT
3161 ** Start a new transaction (if we are not already in the midst of a
3162 ** transaction) and execute the TCL script SCRIPT. After SCRIPT
3163 ** completes, either commit the transaction or roll it back if SCRIPT
3164 ** throws an exception. Or if no new transation was started, do nothing.
3165 ** pass the exception on up the stack.
3167 ** This command was inspired by Dave Thomas's talk on Ruby at the
3168 ** 2005 O'Reilly Open Source Convention (OSCON).
3170 case DB_TRANSACTION: {
3171 Tcl_Obj *pScript;
3172 const char *zBegin = "SAVEPOINT _tcl_transaction";
3173 if( objc!=3 && objc!=4 ){
3174 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
3175 return TCL_ERROR;
3178 if( pDb->nTransaction==0 && objc==4 ){
3179 static const char *TTYPE_strs[] = {
3180 "deferred", "exclusive", "immediate", 0
3182 enum TTYPE_enum {
3183 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
3185 int ttype;
3186 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
3187 0, &ttype) ){
3188 return TCL_ERROR;
3190 switch( (enum TTYPE_enum)ttype ){
3191 case TTYPE_DEFERRED: /* no-op */; break;
3192 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break;
3193 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break;
3196 pScript = objv[objc-1];
3198 /* Run the SQLite BEGIN command to open a transaction or savepoint. */
3199 pDb->disableAuth++;
3200 rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
3201 pDb->disableAuth--;
3202 if( rc!=SQLITE_OK ){
3203 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3204 return TCL_ERROR;
3206 pDb->nTransaction++;
3208 /* If using NRE, schedule a callback to invoke the script pScript, then
3209 ** a second callback to commit (or rollback) the transaction or savepoint
3210 ** opened above. If not using NRE, evaluate the script directly, then
3211 ** call function DbTransPostCmd() to commit (or rollback) the transaction
3212 ** or savepoint. */
3213 if( DbUseNre() ){
3214 Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0);
3215 (void)Tcl_NREvalObj(interp, pScript, 0);
3216 }else{
3217 rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0));
3219 break;
3223 ** $db unlock_notify ?script?
3225 case DB_UNLOCK_NOTIFY: {
3226 #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
3227 Tcl_AppendResult(interp, "unlock_notify not available in this build",
3228 (char*)0);
3229 rc = TCL_ERROR;
3230 #else
3231 if( objc!=2 && objc!=3 ){
3232 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
3233 rc = TCL_ERROR;
3234 }else{
3235 void (*xNotify)(void **, int) = 0;
3236 void *pNotifyArg = 0;
3238 if( pDb->pUnlockNotify ){
3239 Tcl_DecrRefCount(pDb->pUnlockNotify);
3240 pDb->pUnlockNotify = 0;
3243 if( objc==3 ){
3244 xNotify = DbUnlockNotify;
3245 pNotifyArg = (void *)pDb;
3246 pDb->pUnlockNotify = objv[2];
3247 Tcl_IncrRefCount(pDb->pUnlockNotify);
3250 if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
3251 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3252 rc = TCL_ERROR;
3255 #endif
3256 break;
3260 ** $db preupdate_hook count
3261 ** $db preupdate_hook hook ?SCRIPT?
3262 ** $db preupdate_hook new INDEX
3263 ** $db preupdate_hook old INDEX
3265 case DB_PREUPDATE: {
3266 #ifndef SQLITE_ENABLE_PREUPDATE_HOOK
3267 Tcl_AppendResult(interp, "preupdate_hook was omitted at compile-time",
3268 (char*)0);
3269 rc = TCL_ERROR;
3270 #else
3271 static const char *azSub[] = {"count", "depth", "hook", "new", "old", 0};
3272 enum DbPreupdateSubCmd {
3273 PRE_COUNT, PRE_DEPTH, PRE_HOOK, PRE_NEW, PRE_OLD
3275 int iSub;
3277 if( objc<3 ){
3278 Tcl_WrongNumArgs(interp, 2, objv, "SUB-COMMAND ?ARGS?");
3280 if( Tcl_GetIndexFromObj(interp, objv[2], azSub, "sub-command", 0, &iSub) ){
3281 return TCL_ERROR;
3284 switch( (enum DbPreupdateSubCmd)iSub ){
3285 case PRE_COUNT: {
3286 int nCol = sqlite3_preupdate_count(pDb->db);
3287 Tcl_SetObjResult(interp, Tcl_NewIntObj(nCol));
3288 break;
3291 case PRE_HOOK: {
3292 if( objc>4 ){
3293 Tcl_WrongNumArgs(interp, 2, objv, "hook ?SCRIPT?");
3294 return TCL_ERROR;
3296 DbHookCmd(interp, pDb, (objc==4 ? objv[3] : 0), &pDb->pPreUpdateHook);
3297 break;
3300 case PRE_DEPTH: {
3301 Tcl_Obj *pRet;
3302 if( objc!=3 ){
3303 Tcl_WrongNumArgs(interp, 3, objv, "");
3304 return TCL_ERROR;
3306 pRet = Tcl_NewIntObj(sqlite3_preupdate_depth(pDb->db));
3307 Tcl_SetObjResult(interp, pRet);
3308 break;
3311 case PRE_NEW:
3312 case PRE_OLD: {
3313 int iIdx;
3314 sqlite3_value *pValue;
3315 if( objc!=4 ){
3316 Tcl_WrongNumArgs(interp, 3, objv, "INDEX");
3317 return TCL_ERROR;
3319 if( Tcl_GetIntFromObj(interp, objv[3], &iIdx) ){
3320 return TCL_ERROR;
3323 if( iSub==PRE_OLD ){
3324 rc = sqlite3_preupdate_old(pDb->db, iIdx, &pValue);
3325 }else{
3326 assert( iSub==PRE_NEW );
3327 rc = sqlite3_preupdate_new(pDb->db, iIdx, &pValue);
3330 if( rc==SQLITE_OK ){
3331 Tcl_Obj *pObj;
3332 pObj = Tcl_NewStringObj((char*)sqlite3_value_text(pValue), -1);
3333 Tcl_SetObjResult(interp, pObj);
3334 }else{
3335 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3336 return TCL_ERROR;
3340 #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
3341 break;
3345 ** $db wal_hook ?script?
3346 ** $db update_hook ?script?
3347 ** $db rollback_hook ?script?
3349 case DB_WAL_HOOK:
3350 case DB_UPDATE_HOOK:
3351 case DB_ROLLBACK_HOOK: {
3352 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
3353 ** whether [$db update_hook] or [$db rollback_hook] was invoked.
3355 Tcl_Obj **ppHook = 0;
3356 if( choice==DB_WAL_HOOK ) ppHook = &pDb->pWalHook;
3357 if( choice==DB_UPDATE_HOOK ) ppHook = &pDb->pUpdateHook;
3358 if( choice==DB_ROLLBACK_HOOK ) ppHook = &pDb->pRollbackHook;
3359 if( objc>3 ){
3360 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
3361 return TCL_ERROR;
3364 DbHookCmd(interp, pDb, (objc==3 ? objv[2] : 0), ppHook);
3365 break;
3368 /* $db version
3370 ** Return the version string for this database.
3372 case DB_VERSION: {
3373 int i;
3374 for(i=2; i<objc; i++){
3375 const char *zArg = Tcl_GetString(objv[i]);
3376 /* Optional arguments to $db version are used for testing purpose */
3377 #ifdef SQLITE_TEST
3378 /* $db version -use-legacy-prepare BOOLEAN
3380 ** Turn the use of legacy sqlite3_prepare() on or off.
3382 if( strcmp(zArg, "-use-legacy-prepare")==0 && i+1<objc ){
3383 i++;
3384 if( Tcl_GetBooleanFromObj(interp, objv[i], &pDb->bLegacyPrepare) ){
3385 return TCL_ERROR;
3387 }else
3389 /* $db version -last-stmt-ptr
3391 ** Return a string which is a hex encoding of the pointer to the
3392 ** most recent sqlite3_stmt in the statement cache.
3394 if( strcmp(zArg, "-last-stmt-ptr")==0 ){
3395 char zBuf[100];
3396 sqlite3_snprintf(sizeof(zBuf), zBuf, "%p",
3397 pDb->stmtList ? pDb->stmtList->pStmt: 0);
3398 Tcl_SetResult(interp, zBuf, TCL_VOLATILE);
3399 }else
3400 #endif /* SQLITE_TEST */
3402 Tcl_AppendResult(interp, "unknown argument: ", zArg, (char*)0);
3403 return TCL_ERROR;
3406 if( i==2 ){
3407 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
3409 break;
3413 } /* End of the SWITCH statement */
3414 return rc;
3417 #if SQLITE_TCL_NRE
3419 ** Adaptor that provides an objCmd interface to the NRE-enabled
3420 ** interface implementation.
3422 static int SQLITE_TCLAPI DbObjCmdAdaptor(
3423 void *cd,
3424 Tcl_Interp *interp,
3425 int objc,
3426 Tcl_Obj *const*objv
3428 return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
3430 #endif /* SQLITE_TCL_NRE */
3433 ** Issue the usage message when the "sqlite3" command arguments are
3434 ** incorrect.
3436 static int sqliteCmdUsage(
3437 Tcl_Interp *interp,
3438 Tcl_Obj *const*objv
3440 Tcl_WrongNumArgs(interp, 1, objv,
3441 "HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
3442 " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
3443 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3444 " ?-key CODECKEY?"
3445 #endif
3447 return TCL_ERROR;
3451 ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
3452 ** ?-create BOOLEAN? ?-nomutex BOOLEAN?
3454 ** This is the main Tcl command. When the "sqlite" Tcl command is
3455 ** invoked, this routine runs to process that command.
3457 ** The first argument, DBNAME, is an arbitrary name for a new
3458 ** database connection. This command creates a new command named
3459 ** DBNAME that is used to control that connection. The database
3460 ** connection is deleted when the DBNAME command is deleted.
3462 ** The second argument is the name of the database file.
3465 static int SQLITE_TCLAPI DbMain(
3466 void *cd,
3467 Tcl_Interp *interp,
3468 int objc,
3469 Tcl_Obj *const*objv
3471 SqliteDb *p;
3472 const char *zArg;
3473 char *zErrMsg;
3474 int i;
3475 const char *zFile = 0;
3476 const char *zVfs = 0;
3477 int flags;
3478 Tcl_DString translatedFilename;
3479 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3480 void *pKey = 0;
3481 int nKey = 0;
3482 #endif
3483 int rc;
3485 /* In normal use, each TCL interpreter runs in a single thread. So
3486 ** by default, we can turn off mutexing on SQLite database connections.
3487 ** However, for testing purposes it is useful to have mutexes turned
3488 ** on. So, by default, mutexes default off. But if compiled with
3489 ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
3491 #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
3492 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
3493 #else
3494 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
3495 #endif
3497 if( objc==2 ){
3498 zArg = Tcl_GetStringFromObj(objv[1], 0);
3499 if( strcmp(zArg,"-version")==0 ){
3500 Tcl_AppendResult(interp,sqlite3_libversion(), (char*)0);
3501 return TCL_OK;
3503 if( strcmp(zArg,"-sourceid")==0 ){
3504 Tcl_AppendResult(interp,sqlite3_sourceid(), (char*)0);
3505 return TCL_OK;
3507 if( strcmp(zArg,"-has-codec")==0 ){
3508 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3509 Tcl_AppendResult(interp,"1",(char*)0);
3510 #else
3511 Tcl_AppendResult(interp,"0",(char*)0);
3512 #endif
3513 return TCL_OK;
3515 if( zArg[0]=='-' ) return sqliteCmdUsage(interp, objv);
3517 for(i=2; i<objc; i++){
3518 zArg = Tcl_GetString(objv[i]);
3519 if( zArg[0]!='-' ){
3520 if( zFile!=0 ) return sqliteCmdUsage(interp, objv);
3521 zFile = zArg;
3522 continue;
3524 if( i==objc-1 ) return sqliteCmdUsage(interp, objv);
3525 i++;
3526 if( strcmp(zArg,"-key")==0 ){
3527 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3528 pKey = Tcl_GetByteArrayFromObj(objv[i], &nKey);
3529 #endif
3530 }else if( strcmp(zArg, "-vfs")==0 ){
3531 zVfs = Tcl_GetString(objv[i]);
3532 }else if( strcmp(zArg, "-readonly")==0 ){
3533 int b;
3534 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3535 if( b ){
3536 flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
3537 flags |= SQLITE_OPEN_READONLY;
3538 }else{
3539 flags &= ~SQLITE_OPEN_READONLY;
3540 flags |= SQLITE_OPEN_READWRITE;
3542 }else if( strcmp(zArg, "-create")==0 ){
3543 int b;
3544 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3545 if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
3546 flags |= SQLITE_OPEN_CREATE;
3547 }else{
3548 flags &= ~SQLITE_OPEN_CREATE;
3550 }else if( strcmp(zArg, "-nomutex")==0 ){
3551 int b;
3552 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3553 if( b ){
3554 flags |= SQLITE_OPEN_NOMUTEX;
3555 flags &= ~SQLITE_OPEN_FULLMUTEX;
3556 }else{
3557 flags &= ~SQLITE_OPEN_NOMUTEX;
3559 }else if( strcmp(zArg, "-fullmutex")==0 ){
3560 int b;
3561 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3562 if( b ){
3563 flags |= SQLITE_OPEN_FULLMUTEX;
3564 flags &= ~SQLITE_OPEN_NOMUTEX;
3565 }else{
3566 flags &= ~SQLITE_OPEN_FULLMUTEX;
3568 }else if( strcmp(zArg, "-uri")==0 ){
3569 int b;
3570 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3571 if( b ){
3572 flags |= SQLITE_OPEN_URI;
3573 }else{
3574 flags &= ~SQLITE_OPEN_URI;
3576 }else{
3577 Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
3578 return TCL_ERROR;
3581 zErrMsg = 0;
3582 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
3583 memset(p, 0, sizeof(*p));
3584 if( zFile==0 ) zFile = "";
3585 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
3586 rc = sqlite3_open_v2(zFile, &p->db, flags, zVfs);
3587 Tcl_DStringFree(&translatedFilename);
3588 if( p->db ){
3589 if( SQLITE_OK!=sqlite3_errcode(p->db) ){
3590 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
3591 sqlite3_close(p->db);
3592 p->db = 0;
3594 }else{
3595 zErrMsg = sqlite3_mprintf("%s", sqlite3_errstr(rc));
3597 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3598 if( p->db ){
3599 sqlite3_key(p->db, pKey, nKey);
3601 #endif
3602 if( p->db==0 ){
3603 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
3604 Tcl_Free((char*)p);
3605 sqlite3_free(zErrMsg);
3606 return TCL_ERROR;
3608 p->maxStmt = NUM_PREPARED_STMTS;
3609 p->openFlags = flags & SQLITE_OPEN_URI;
3610 p->interp = interp;
3611 zArg = Tcl_GetStringFromObj(objv[1], 0);
3612 if( DbUseNre() ){
3613 Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
3614 (char*)p, DbDeleteCmd);
3615 }else{
3616 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
3618 return TCL_OK;
3622 ** Provide a dummy Tcl_InitStubs if we are using this as a static
3623 ** library.
3625 #ifndef USE_TCL_STUBS
3626 # undef Tcl_InitStubs
3627 # define Tcl_InitStubs(a,b,c) TCL_VERSION
3628 #endif
3631 ** Make sure we have a PACKAGE_VERSION macro defined. This will be
3632 ** defined automatically by the TEA makefile. But other makefiles
3633 ** do not define it.
3635 #ifndef PACKAGE_VERSION
3636 # define PACKAGE_VERSION SQLITE_VERSION
3637 #endif
3640 ** Initialize this module.
3642 ** This Tcl module contains only a single new Tcl command named "sqlite".
3643 ** (Hence there is no namespace. There is no point in using a namespace
3644 ** if the extension only supplies one new name!) The "sqlite" command is
3645 ** used to open a new SQLite database. See the DbMain() routine above
3646 ** for additional information.
3648 ** The EXTERN macros are required by TCL in order to work on windows.
3650 EXTERN int Sqlite3_Init(Tcl_Interp *interp){
3651 int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR;
3652 if( rc==TCL_OK ){
3653 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
3654 #ifndef SQLITE_3_SUFFIX_ONLY
3655 /* The "sqlite" alias is undocumented. It is here only to support
3656 ** legacy scripts. All new scripts should use only the "sqlite3"
3657 ** command. */
3658 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
3659 #endif
3660 rc = Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
3662 return rc;
3664 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
3665 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3666 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3668 /* Because it accesses the file-system and uses persistent state, SQLite
3669 ** is not considered appropriate for safe interpreters. Hence, we cause
3670 ** the _SafeInit() interfaces return TCL_ERROR.
3672 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; }
3673 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;}
3677 #ifndef SQLITE_3_SUFFIX_ONLY
3678 int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
3679 int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
3680 int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3681 int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3682 #endif
3685 ** If the TCLSH macro is defined, add code to make a stand-alone program.
3687 #if defined(TCLSH)
3689 /* This is the main routine for an ordinary TCL shell. If there are
3690 ** are arguments, run the first argument as a script. Otherwise,
3691 ** read TCL commands from standard input
3693 static const char *tclsh_main_loop(void){
3694 static const char zMainloop[] =
3695 "if {[llength $argv]>=1} {\n"
3696 "set argv0 [lindex $argv 0]\n"
3697 "set argv [lrange $argv 1 end]\n"
3698 "source $argv0\n"
3699 "} else {\n"
3700 "set line {}\n"
3701 "while {![eof stdin]} {\n"
3702 "if {$line!=\"\"} {\n"
3703 "puts -nonewline \"> \"\n"
3704 "} else {\n"
3705 "puts -nonewline \"% \"\n"
3706 "}\n"
3707 "flush stdout\n"
3708 "append line [gets stdin]\n"
3709 "if {[info complete $line]} {\n"
3710 "if {[catch {uplevel #0 $line} result]} {\n"
3711 "puts stderr \"Error: $result\"\n"
3712 "} elseif {$result!=\"\"} {\n"
3713 "puts $result\n"
3714 "}\n"
3715 "set line {}\n"
3716 "} else {\n"
3717 "append line \\n\n"
3718 "}\n"
3719 "}\n"
3720 "}\n"
3722 return zMainloop;
3725 #define TCLSH_MAIN main /* Needed to fake out mktclapp */
3726 int SQLITE_CDECL TCLSH_MAIN(int argc, char **argv){
3727 Tcl_Interp *interp;
3728 int i;
3729 const char *zScript = 0;
3730 char zArgc[32];
3731 #if defined(TCLSH_INIT_PROC)
3732 extern const char *TCLSH_INIT_PROC(Tcl_Interp*);
3733 #endif
3735 #if !defined(_WIN32_WCE)
3736 if( getenv("BREAK") ){
3737 fprintf(stderr,
3738 "attach debugger to process %d and press any key to continue.\n",
3739 GETPID());
3740 fgetc(stdin);
3742 #endif
3744 /* Call sqlite3_shutdown() once before doing anything else. This is to
3745 ** test that sqlite3_shutdown() can be safely called by a process before
3746 ** sqlite3_initialize() is. */
3747 sqlite3_shutdown();
3749 Tcl_FindExecutable(argv[0]);
3750 Tcl_SetSystemEncoding(NULL, "utf-8");
3751 interp = Tcl_CreateInterp();
3752 Sqlite3_Init(interp);
3754 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-1);
3755 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
3756 Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
3757 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
3758 for(i=1; i<argc; i++){
3759 Tcl_SetVar(interp, "argv", argv[i],
3760 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
3762 #if defined(TCLSH_INIT_PROC)
3763 zScript = TCLSH_INIT_PROC(interp);
3764 #endif
3765 if( zScript==0 ){
3766 zScript = tclsh_main_loop();
3768 if( Tcl_GlobalEval(interp, zScript)!=TCL_OK ){
3769 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
3770 if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
3771 fprintf(stderr,"%s: %s\n", *argv, zInfo);
3772 return 1;
3774 return 0;
3776 #endif /* TCLSH */