Completely disable the skip-ahead-distinct optimization for all but the
[sqlite.git] / src / tclsqlite.c
blobeed86eee34a45e98b9ade2c483282e8d63be8284
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 # define WIN32_LEAN_AND_MEAN
68 # include <windows.h>
69 # endif
70 # define GETPID (int)GetCurrentProcessId
71 #endif
74 * Windows needs to know which symbols to export. Unix does not.
75 * BUILD_sqlite should be undefined for Unix.
77 #ifdef BUILD_sqlite
78 #undef TCL_STORAGE_CLASS
79 #define TCL_STORAGE_CLASS DLLEXPORT
80 #endif /* BUILD_sqlite */
82 #define NUM_PREPARED_STMTS 10
83 #define MAX_PREPARED_STMTS 100
85 /* Forward declaration */
86 typedef struct SqliteDb SqliteDb;
89 ** New SQL functions can be created as TCL scripts. Each such function
90 ** is described by an instance of the following structure.
92 typedef struct SqlFunc SqlFunc;
93 struct SqlFunc {
94 Tcl_Interp *interp; /* The TCL interpret to execute the function */
95 Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */
96 SqliteDb *pDb; /* Database connection that owns this function */
97 int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */
98 char *zName; /* Name of this function */
99 SqlFunc *pNext; /* Next function on the list of them all */
103 ** New collation sequences function can be created as TCL scripts. Each such
104 ** function is described by an instance of the following structure.
106 typedef struct SqlCollate SqlCollate;
107 struct SqlCollate {
108 Tcl_Interp *interp; /* The TCL interpret to execute the function */
109 char *zScript; /* The script to be run */
110 SqlCollate *pNext; /* Next function on the list of them all */
114 ** Prepared statements are cached for faster execution. Each prepared
115 ** statement is described by an instance of the following structure.
117 typedef struct SqlPreparedStmt SqlPreparedStmt;
118 struct SqlPreparedStmt {
119 SqlPreparedStmt *pNext; /* Next in linked list */
120 SqlPreparedStmt *pPrev; /* Previous on the list */
121 sqlite3_stmt *pStmt; /* The prepared statement */
122 int nSql; /* chars in zSql[] */
123 const char *zSql; /* Text of the SQL statement */
124 int nParm; /* Size of apParm array */
125 Tcl_Obj **apParm; /* Array of referenced object pointers */
128 typedef struct IncrblobChannel IncrblobChannel;
131 ** There is one instance of this structure for each SQLite database
132 ** that has been opened by the SQLite TCL interface.
134 ** If this module is built with SQLITE_TEST defined (to create the SQLite
135 ** testfixture executable), then it may be configured to use either
136 ** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.
137 ** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.
139 struct SqliteDb {
140 sqlite3 *db; /* The "real" database structure. MUST BE FIRST */
141 Tcl_Interp *interp; /* The interpreter used for this database */
142 char *zBusy; /* The busy callback routine */
143 char *zCommit; /* The commit hook callback routine */
144 char *zTrace; /* The trace callback routine */
145 char *zTraceV2; /* The trace_v2 callback routine */
146 char *zProfile; /* The profile callback routine */
147 char *zProgress; /* The progress callback routine */
148 char *zAuth; /* The authorization callback routine */
149 int disableAuth; /* Disable the authorizer if it exists */
150 char *zNull; /* Text to substitute for an SQL NULL value */
151 SqlFunc *pFunc; /* List of SQL functions */
152 Tcl_Obj *pUpdateHook; /* Update hook script (if any) */
153 Tcl_Obj *pPreUpdateHook; /* Pre-update hook script (if any) */
154 Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */
155 Tcl_Obj *pWalHook; /* WAL hook script (if any) */
156 Tcl_Obj *pUnlockNotify; /* Unlock notify script (if any) */
157 SqlCollate *pCollate; /* List of SQL collation functions */
158 int rc; /* Return code of most recent sqlite3_exec() */
159 Tcl_Obj *pCollateNeeded; /* Collation needed script */
160 SqlPreparedStmt *stmtList; /* List of prepared statements*/
161 SqlPreparedStmt *stmtLast; /* Last statement in the list */
162 int maxStmt; /* The next maximum number of stmtList */
163 int nStmt; /* Number of statements in stmtList */
164 IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
165 int nStep, nSort, nIndex; /* Statistics for most recent operation */
166 int nVMStep; /* Another statistic for most recent operation */
167 int nTransaction; /* Number of nested [transaction] methods */
168 int openFlags; /* Flags used to open. (SQLITE_OPEN_URI) */
169 #ifdef SQLITE_TEST
170 int bLegacyPrepare; /* True to use sqlite3_prepare() */
171 #endif
174 struct IncrblobChannel {
175 sqlite3_blob *pBlob; /* sqlite3 blob handle */
176 SqliteDb *pDb; /* Associated database connection */
177 int iSeek; /* Current seek offset */
178 Tcl_Channel channel; /* Channel identifier */
179 IncrblobChannel *pNext; /* Linked list of all open incrblob channels */
180 IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */
184 ** Compute a string length that is limited to what can be stored in
185 ** lower 30 bits of a 32-bit signed integer.
187 static int strlen30(const char *z){
188 const char *z2 = z;
189 while( *z2 ){ z2++; }
190 return 0x3fffffff & (int)(z2 - z);
194 #ifndef SQLITE_OMIT_INCRBLOB
196 ** Close all incrblob channels opened using database connection pDb.
197 ** This is called when shutting down the database connection.
199 static void closeIncrblobChannels(SqliteDb *pDb){
200 IncrblobChannel *p;
201 IncrblobChannel *pNext;
203 for(p=pDb->pIncrblob; p; p=pNext){
204 pNext = p->pNext;
206 /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
207 ** which deletes the IncrblobChannel structure at *p. So do not
208 ** call Tcl_Free() here.
210 Tcl_UnregisterChannel(pDb->interp, p->channel);
215 ** Close an incremental blob channel.
217 static int SQLITE_TCLAPI incrblobClose(
218 ClientData instanceData,
219 Tcl_Interp *interp
221 IncrblobChannel *p = (IncrblobChannel *)instanceData;
222 int rc = sqlite3_blob_close(p->pBlob);
223 sqlite3 *db = p->pDb->db;
225 /* Remove the channel from the SqliteDb.pIncrblob list. */
226 if( p->pNext ){
227 p->pNext->pPrev = p->pPrev;
229 if( p->pPrev ){
230 p->pPrev->pNext = p->pNext;
232 if( p->pDb->pIncrblob==p ){
233 p->pDb->pIncrblob = p->pNext;
236 /* Free the IncrblobChannel structure */
237 Tcl_Free((char *)p);
239 if( rc!=SQLITE_OK ){
240 Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
241 return TCL_ERROR;
243 return TCL_OK;
247 ** Read data from an incremental blob channel.
249 static int SQLITE_TCLAPI incrblobInput(
250 ClientData instanceData,
251 char *buf,
252 int bufSize,
253 int *errorCodePtr
255 IncrblobChannel *p = (IncrblobChannel *)instanceData;
256 int nRead = bufSize; /* Number of bytes to read */
257 int nBlob; /* Total size of the blob */
258 int rc; /* sqlite error code */
260 nBlob = sqlite3_blob_bytes(p->pBlob);
261 if( (p->iSeek+nRead)>nBlob ){
262 nRead = nBlob-p->iSeek;
264 if( nRead<=0 ){
265 return 0;
268 rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
269 if( rc!=SQLITE_OK ){
270 *errorCodePtr = rc;
271 return -1;
274 p->iSeek += nRead;
275 return nRead;
279 ** Write data to an incremental blob channel.
281 static int SQLITE_TCLAPI incrblobOutput(
282 ClientData instanceData,
283 CONST char *buf,
284 int toWrite,
285 int *errorCodePtr
287 IncrblobChannel *p = (IncrblobChannel *)instanceData;
288 int nWrite = toWrite; /* Number of bytes to write */
289 int nBlob; /* Total size of the blob */
290 int rc; /* sqlite error code */
292 nBlob = sqlite3_blob_bytes(p->pBlob);
293 if( (p->iSeek+nWrite)>nBlob ){
294 *errorCodePtr = EINVAL;
295 return -1;
297 if( nWrite<=0 ){
298 return 0;
301 rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
302 if( rc!=SQLITE_OK ){
303 *errorCodePtr = EIO;
304 return -1;
307 p->iSeek += nWrite;
308 return nWrite;
312 ** Seek an incremental blob channel.
314 static int SQLITE_TCLAPI incrblobSeek(
315 ClientData instanceData,
316 long offset,
317 int seekMode,
318 int *errorCodePtr
320 IncrblobChannel *p = (IncrblobChannel *)instanceData;
322 switch( seekMode ){
323 case SEEK_SET:
324 p->iSeek = offset;
325 break;
326 case SEEK_CUR:
327 p->iSeek += offset;
328 break;
329 case SEEK_END:
330 p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
331 break;
333 default: assert(!"Bad seekMode");
336 return p->iSeek;
340 static void SQLITE_TCLAPI incrblobWatch(
341 ClientData instanceData,
342 int mode
344 /* NO-OP */
346 static int SQLITE_TCLAPI incrblobHandle(
347 ClientData instanceData,
348 int dir,
349 ClientData *hPtr
351 return TCL_ERROR;
354 static Tcl_ChannelType IncrblobChannelType = {
355 "incrblob", /* typeName */
356 TCL_CHANNEL_VERSION_2, /* version */
357 incrblobClose, /* closeProc */
358 incrblobInput, /* inputProc */
359 incrblobOutput, /* outputProc */
360 incrblobSeek, /* seekProc */
361 0, /* setOptionProc */
362 0, /* getOptionProc */
363 incrblobWatch, /* watchProc (this is a no-op) */
364 incrblobHandle, /* getHandleProc (always returns error) */
365 0, /* close2Proc */
366 0, /* blockModeProc */
367 0, /* flushProc */
368 0, /* handlerProc */
369 0, /* wideSeekProc */
373 ** Create a new incrblob channel.
375 static int createIncrblobChannel(
376 Tcl_Interp *interp,
377 SqliteDb *pDb,
378 const char *zDb,
379 const char *zTable,
380 const char *zColumn,
381 sqlite_int64 iRow,
382 int isReadonly
384 IncrblobChannel *p;
385 sqlite3 *db = pDb->db;
386 sqlite3_blob *pBlob;
387 int rc;
388 int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
390 /* This variable is used to name the channels: "incrblob_[incr count]" */
391 static int count = 0;
392 char zChannel[64];
394 rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
395 if( rc!=SQLITE_OK ){
396 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
397 return TCL_ERROR;
400 p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
401 p->iSeek = 0;
402 p->pBlob = pBlob;
404 sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
405 p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
406 Tcl_RegisterChannel(interp, p->channel);
408 /* Link the new channel into the SqliteDb.pIncrblob list. */
409 p->pNext = pDb->pIncrblob;
410 p->pPrev = 0;
411 if( p->pNext ){
412 p->pNext->pPrev = p;
414 pDb->pIncrblob = p;
415 p->pDb = pDb;
417 Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
418 return TCL_OK;
420 #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
421 #define closeIncrblobChannels(pDb)
422 #endif
425 ** Look at the script prefix in pCmd. We will be executing this script
426 ** after first appending one or more arguments. This routine analyzes
427 ** the script to see if it is safe to use Tcl_EvalObjv() on the script
428 ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much
429 ** faster.
431 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
432 ** command name followed by zero or more arguments with no [...] or $
433 ** or {...} or ; to be seen anywhere. Most callback scripts consist
434 ** of just a single procedure name and they meet this requirement.
436 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
437 /* We could try to do something with Tcl_Parse(). But we will instead
438 ** just do a search for forbidden characters. If any of the forbidden
439 ** characters appear in pCmd, we will report the string as unsafe.
441 const char *z;
442 int n;
443 z = Tcl_GetStringFromObj(pCmd, &n);
444 while( n-- > 0 ){
445 int c = *(z++);
446 if( c=='$' || c=='[' || c==';' ) return 0;
448 return 1;
452 ** Find an SqlFunc structure with the given name. Or create a new
453 ** one if an existing one cannot be found. Return a pointer to the
454 ** structure.
456 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
457 SqlFunc *p, *pNew;
458 int nName = strlen30(zName);
459 pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );
460 pNew->zName = (char*)&pNew[1];
461 memcpy(pNew->zName, zName, nName+1);
462 for(p=pDb->pFunc; p; p=p->pNext){
463 if( sqlite3_stricmp(p->zName, pNew->zName)==0 ){
464 Tcl_Free((char*)pNew);
465 return p;
468 pNew->interp = pDb->interp;
469 pNew->pDb = pDb;
470 pNew->pScript = 0;
471 pNew->pNext = pDb->pFunc;
472 pDb->pFunc = pNew;
473 return pNew;
477 ** Free a single SqlPreparedStmt object.
479 static void dbFreeStmt(SqlPreparedStmt *pStmt){
480 #ifdef SQLITE_TEST
481 if( sqlite3_sql(pStmt->pStmt)==0 ){
482 Tcl_Free((char *)pStmt->zSql);
484 #endif
485 sqlite3_finalize(pStmt->pStmt);
486 Tcl_Free((char *)pStmt);
490 ** Finalize and free a list of prepared statements
492 static void flushStmtCache(SqliteDb *pDb){
493 SqlPreparedStmt *pPreStmt;
494 SqlPreparedStmt *pNext;
496 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pNext){
497 pNext = pPreStmt->pNext;
498 dbFreeStmt(pPreStmt);
500 pDb->nStmt = 0;
501 pDb->stmtLast = 0;
502 pDb->stmtList = 0;
506 ** TCL calls this procedure when an sqlite3 database command is
507 ** deleted.
509 static void SQLITE_TCLAPI DbDeleteCmd(void *db){
510 SqliteDb *pDb = (SqliteDb*)db;
511 flushStmtCache(pDb);
512 closeIncrblobChannels(pDb);
513 sqlite3_close(pDb->db);
514 while( pDb->pFunc ){
515 SqlFunc *pFunc = pDb->pFunc;
516 pDb->pFunc = pFunc->pNext;
517 assert( pFunc->pDb==pDb );
518 Tcl_DecrRefCount(pFunc->pScript);
519 Tcl_Free((char*)pFunc);
521 while( pDb->pCollate ){
522 SqlCollate *pCollate = pDb->pCollate;
523 pDb->pCollate = pCollate->pNext;
524 Tcl_Free((char*)pCollate);
526 if( pDb->zBusy ){
527 Tcl_Free(pDb->zBusy);
529 if( pDb->zTrace ){
530 Tcl_Free(pDb->zTrace);
532 if( pDb->zTraceV2 ){
533 Tcl_Free(pDb->zTraceV2);
535 if( pDb->zProfile ){
536 Tcl_Free(pDb->zProfile);
538 if( pDb->zAuth ){
539 Tcl_Free(pDb->zAuth);
541 if( pDb->zNull ){
542 Tcl_Free(pDb->zNull);
544 if( pDb->pUpdateHook ){
545 Tcl_DecrRefCount(pDb->pUpdateHook);
547 if( pDb->pPreUpdateHook ){
548 Tcl_DecrRefCount(pDb->pPreUpdateHook);
550 if( pDb->pRollbackHook ){
551 Tcl_DecrRefCount(pDb->pRollbackHook);
553 if( pDb->pWalHook ){
554 Tcl_DecrRefCount(pDb->pWalHook);
556 if( pDb->pCollateNeeded ){
557 Tcl_DecrRefCount(pDb->pCollateNeeded);
559 Tcl_Free((char*)pDb);
563 ** This routine is called when a database file is locked while trying
564 ** to execute SQL.
566 static int DbBusyHandler(void *cd, int nTries){
567 SqliteDb *pDb = (SqliteDb*)cd;
568 int rc;
569 char zVal[30];
571 sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
572 rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
573 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
574 return 0;
576 return 1;
579 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
581 ** This routine is invoked as the 'progress callback' for the database.
583 static int DbProgressHandler(void *cd){
584 SqliteDb *pDb = (SqliteDb*)cd;
585 int rc;
587 assert( pDb->zProgress );
588 rc = Tcl_Eval(pDb->interp, pDb->zProgress);
589 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
590 return 1;
592 return 0;
594 #endif
596 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
597 !defined(SQLITE_OMIT_DEPRECATED)
599 ** This routine is called by the SQLite trace handler whenever a new
600 ** block of SQL is executed. The TCL script in pDb->zTrace is executed.
602 static void DbTraceHandler(void *cd, const char *zSql){
603 SqliteDb *pDb = (SqliteDb*)cd;
604 Tcl_DString str;
606 Tcl_DStringInit(&str);
607 Tcl_DStringAppend(&str, pDb->zTrace, -1);
608 Tcl_DStringAppendElement(&str, zSql);
609 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
610 Tcl_DStringFree(&str);
611 Tcl_ResetResult(pDb->interp);
613 #endif
615 #ifndef SQLITE_OMIT_TRACE
617 ** This routine is called by the SQLite trace_v2 handler whenever a new
618 ** supported event is generated. Unsupported event types are ignored.
619 ** The TCL script in pDb->zTraceV2 is executed, with the arguments for
620 ** the event appended to it (as list elements).
622 static int DbTraceV2Handler(
623 unsigned type, /* One of the SQLITE_TRACE_* event types. */
624 void *cd, /* The original context data pointer. */
625 void *pd, /* Primary event data, depends on event type. */
626 void *xd /* Extra event data, depends on event type. */
628 SqliteDb *pDb = (SqliteDb*)cd;
629 Tcl_Obj *pCmd;
631 switch( type ){
632 case SQLITE_TRACE_STMT: {
633 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
634 char *zSql = (char *)xd;
636 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
637 Tcl_IncrRefCount(pCmd);
638 Tcl_ListObjAppendElement(pDb->interp, pCmd,
639 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
640 Tcl_ListObjAppendElement(pDb->interp, pCmd,
641 Tcl_NewStringObj(zSql, -1));
642 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
643 Tcl_DecrRefCount(pCmd);
644 Tcl_ResetResult(pDb->interp);
645 break;
647 case SQLITE_TRACE_PROFILE: {
648 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
649 sqlite3_int64 ns = (sqlite3_int64)xd;
651 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
652 Tcl_IncrRefCount(pCmd);
653 Tcl_ListObjAppendElement(pDb->interp, pCmd,
654 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
655 Tcl_ListObjAppendElement(pDb->interp, pCmd,
656 Tcl_NewWideIntObj((Tcl_WideInt)ns));
657 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
658 Tcl_DecrRefCount(pCmd);
659 Tcl_ResetResult(pDb->interp);
660 break;
662 case SQLITE_TRACE_ROW: {
663 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
665 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
666 Tcl_IncrRefCount(pCmd);
667 Tcl_ListObjAppendElement(pDb->interp, pCmd,
668 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
669 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
670 Tcl_DecrRefCount(pCmd);
671 Tcl_ResetResult(pDb->interp);
672 break;
674 case SQLITE_TRACE_CLOSE: {
675 sqlite3 *db = (sqlite3 *)pd;
677 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
678 Tcl_IncrRefCount(pCmd);
679 Tcl_ListObjAppendElement(pDb->interp, pCmd,
680 Tcl_NewWideIntObj((Tcl_WideInt)db));
681 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
682 Tcl_DecrRefCount(pCmd);
683 Tcl_ResetResult(pDb->interp);
684 break;
687 return SQLITE_OK;
689 #endif
691 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
692 !defined(SQLITE_OMIT_DEPRECATED)
694 ** This routine is called by the SQLite profile handler after a statement
695 ** SQL has executed. The TCL script in pDb->zProfile is evaluated.
697 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
698 SqliteDb *pDb = (SqliteDb*)cd;
699 Tcl_DString str;
700 char zTm[100];
702 sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
703 Tcl_DStringInit(&str);
704 Tcl_DStringAppend(&str, pDb->zProfile, -1);
705 Tcl_DStringAppendElement(&str, zSql);
706 Tcl_DStringAppendElement(&str, zTm);
707 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
708 Tcl_DStringFree(&str);
709 Tcl_ResetResult(pDb->interp);
711 #endif
714 ** This routine is called when a transaction is committed. The
715 ** TCL script in pDb->zCommit is executed. If it returns non-zero or
716 ** if it throws an exception, the transaction is rolled back instead
717 ** of being committed.
719 static int DbCommitHandler(void *cd){
720 SqliteDb *pDb = (SqliteDb*)cd;
721 int rc;
723 rc = Tcl_Eval(pDb->interp, pDb->zCommit);
724 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
725 return 1;
727 return 0;
730 static void DbRollbackHandler(void *clientData){
731 SqliteDb *pDb = (SqliteDb*)clientData;
732 assert(pDb->pRollbackHook);
733 if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
734 Tcl_BackgroundError(pDb->interp);
739 ** This procedure handles wal_hook callbacks.
741 static int DbWalHandler(
742 void *clientData,
743 sqlite3 *db,
744 const char *zDb,
745 int nEntry
747 int ret = SQLITE_OK;
748 Tcl_Obj *p;
749 SqliteDb *pDb = (SqliteDb*)clientData;
750 Tcl_Interp *interp = pDb->interp;
751 assert(pDb->pWalHook);
753 assert( db==pDb->db );
754 p = Tcl_DuplicateObj(pDb->pWalHook);
755 Tcl_IncrRefCount(p);
756 Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));
757 Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));
758 if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)
759 || TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)
761 Tcl_BackgroundError(interp);
763 Tcl_DecrRefCount(p);
765 return ret;
768 #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
769 static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){
770 char zBuf[64];
771 sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", iArg);
772 Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);
773 sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", nArg);
774 Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);
776 #else
777 # define setTestUnlockNotifyVars(x,y,z)
778 #endif
780 #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
781 static void DbUnlockNotify(void **apArg, int nArg){
782 int i;
783 for(i=0; i<nArg; i++){
784 const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
785 SqliteDb *pDb = (SqliteDb *)apArg[i];
786 setTestUnlockNotifyVars(pDb->interp, i, nArg);
787 assert( pDb->pUnlockNotify);
788 Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
789 Tcl_DecrRefCount(pDb->pUnlockNotify);
790 pDb->pUnlockNotify = 0;
793 #endif
795 #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
797 ** Pre-update hook callback.
799 static void DbPreUpdateHandler(
800 void *p,
801 sqlite3 *db,
802 int op,
803 const char *zDb,
804 const char *zTbl,
805 sqlite_int64 iKey1,
806 sqlite_int64 iKey2
808 SqliteDb *pDb = (SqliteDb *)p;
809 Tcl_Obj *pCmd;
810 static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
812 assert( (SQLITE_DELETE-1)/9 == 0 );
813 assert( (SQLITE_INSERT-1)/9 == 1 );
814 assert( (SQLITE_UPDATE-1)/9 == 2 );
815 assert( pDb->pPreUpdateHook );
816 assert( db==pDb->db );
817 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
819 pCmd = Tcl_DuplicateObj(pDb->pPreUpdateHook);
820 Tcl_IncrRefCount(pCmd);
821 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
822 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
823 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
824 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey1));
825 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey2));
826 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
827 Tcl_DecrRefCount(pCmd);
829 #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
831 static void DbUpdateHandler(
832 void *p,
833 int op,
834 const char *zDb,
835 const char *zTbl,
836 sqlite_int64 rowid
838 SqliteDb *pDb = (SqliteDb *)p;
839 Tcl_Obj *pCmd;
840 static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
842 assert( (SQLITE_DELETE-1)/9 == 0 );
843 assert( (SQLITE_INSERT-1)/9 == 1 );
844 assert( (SQLITE_UPDATE-1)/9 == 2 );
846 assert( pDb->pUpdateHook );
847 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
849 pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
850 Tcl_IncrRefCount(pCmd);
851 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
852 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
853 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
854 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
855 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
856 Tcl_DecrRefCount(pCmd);
859 static void tclCollateNeeded(
860 void *pCtx,
861 sqlite3 *db,
862 int enc,
863 const char *zName
865 SqliteDb *pDb = (SqliteDb *)pCtx;
866 Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
867 Tcl_IncrRefCount(pScript);
868 Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
869 Tcl_EvalObjEx(pDb->interp, pScript, 0);
870 Tcl_DecrRefCount(pScript);
874 ** This routine is called to evaluate an SQL collation function implemented
875 ** using TCL script.
877 static int tclSqlCollate(
878 void *pCtx,
879 int nA,
880 const void *zA,
881 int nB,
882 const void *zB
884 SqlCollate *p = (SqlCollate *)pCtx;
885 Tcl_Obj *pCmd;
887 pCmd = Tcl_NewStringObj(p->zScript, -1);
888 Tcl_IncrRefCount(pCmd);
889 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
890 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
891 Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
892 Tcl_DecrRefCount(pCmd);
893 return (atoi(Tcl_GetStringResult(p->interp)));
897 ** This routine is called to evaluate an SQL function implemented
898 ** using TCL script.
900 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
901 SqlFunc *p = sqlite3_user_data(context);
902 Tcl_Obj *pCmd;
903 int i;
904 int rc;
906 if( argc==0 ){
907 /* If there are no arguments to the function, call Tcl_EvalObjEx on the
908 ** script object directly. This allows the TCL compiler to generate
909 ** bytecode for the command on the first invocation and thus make
910 ** subsequent invocations much faster. */
911 pCmd = p->pScript;
912 Tcl_IncrRefCount(pCmd);
913 rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
914 Tcl_DecrRefCount(pCmd);
915 }else{
916 /* If there are arguments to the function, make a shallow copy of the
917 ** script object, lappend the arguments, then evaluate the copy.
919 ** By "shallow" copy, we mean only the outer list Tcl_Obj is duplicated.
920 ** The new Tcl_Obj contains pointers to the original list elements.
921 ** That way, when Tcl_EvalObjv() is run and shimmers the first element
922 ** of the list to tclCmdNameType, that alternate representation will
923 ** be preserved and reused on the next invocation.
925 Tcl_Obj **aArg;
926 int nArg;
927 if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
928 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
929 return;
931 pCmd = Tcl_NewListObj(nArg, aArg);
932 Tcl_IncrRefCount(pCmd);
933 for(i=0; i<argc; i++){
934 sqlite3_value *pIn = argv[i];
935 Tcl_Obj *pVal;
937 /* Set pVal to contain the i'th column of this row. */
938 switch( sqlite3_value_type(pIn) ){
939 case SQLITE_BLOB: {
940 int bytes = sqlite3_value_bytes(pIn);
941 pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
942 break;
944 case SQLITE_INTEGER: {
945 sqlite_int64 v = sqlite3_value_int64(pIn);
946 if( v>=-2147483647 && v<=2147483647 ){
947 pVal = Tcl_NewIntObj((int)v);
948 }else{
949 pVal = Tcl_NewWideIntObj(v);
951 break;
953 case SQLITE_FLOAT: {
954 double r = sqlite3_value_double(pIn);
955 pVal = Tcl_NewDoubleObj(r);
956 break;
958 case SQLITE_NULL: {
959 pVal = Tcl_NewStringObj(p->pDb->zNull, -1);
960 break;
962 default: {
963 int bytes = sqlite3_value_bytes(pIn);
964 pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
965 break;
968 rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
969 if( rc ){
970 Tcl_DecrRefCount(pCmd);
971 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
972 return;
975 if( !p->useEvalObjv ){
976 /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
977 ** is a list without a string representation. To prevent this from
978 ** happening, make sure pCmd has a valid string representation */
979 Tcl_GetString(pCmd);
981 rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
982 Tcl_DecrRefCount(pCmd);
985 if( rc && rc!=TCL_RETURN ){
986 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
987 }else{
988 Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
989 int n;
990 u8 *data;
991 const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
992 char c = zType[0];
993 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
994 /* Only return a BLOB type if the Tcl variable is a bytearray and
995 ** has no string representation. */
996 data = Tcl_GetByteArrayFromObj(pVar, &n);
997 sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
998 }else if( c=='b' && strcmp(zType,"boolean")==0 ){
999 Tcl_GetIntFromObj(0, pVar, &n);
1000 sqlite3_result_int(context, n);
1001 }else if( c=='d' && strcmp(zType,"double")==0 ){
1002 double r;
1003 Tcl_GetDoubleFromObj(0, pVar, &r);
1004 sqlite3_result_double(context, r);
1005 }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
1006 (c=='i' && strcmp(zType,"int")==0) ){
1007 Tcl_WideInt v;
1008 Tcl_GetWideIntFromObj(0, pVar, &v);
1009 sqlite3_result_int64(context, v);
1010 }else{
1011 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
1012 sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
1017 #ifndef SQLITE_OMIT_AUTHORIZATION
1019 ** This is the authentication function. It appends the authentication
1020 ** type code and the two arguments to zCmd[] then invokes the result
1021 ** on the interpreter. The reply is examined to determine if the
1022 ** authentication fails or succeeds.
1024 static int auth_callback(
1025 void *pArg,
1026 int code,
1027 const char *zArg1,
1028 const char *zArg2,
1029 const char *zArg3,
1030 const char *zArg4
1031 #ifdef SQLITE_USER_AUTHENTICATION
1032 ,const char *zArg5
1033 #endif
1035 const char *zCode;
1036 Tcl_DString str;
1037 int rc;
1038 const char *zReply;
1039 /* EVIDENCE-OF: R-38590-62769 The first parameter to the authorizer
1040 ** callback is a copy of the third parameter to the
1041 ** sqlite3_set_authorizer() interface.
1043 SqliteDb *pDb = (SqliteDb*)pArg;
1044 if( pDb->disableAuth ) return SQLITE_OK;
1046 /* EVIDENCE-OF: R-56518-44310 The second parameter to the callback is an
1047 ** integer action code that specifies the particular action to be
1048 ** authorized. */
1049 switch( code ){
1050 case SQLITE_COPY : zCode="SQLITE_COPY"; break;
1051 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
1052 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
1053 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
1054 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
1055 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
1056 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
1057 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
1058 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
1059 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
1060 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
1061 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
1062 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
1063 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
1064 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
1065 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
1066 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
1067 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
1068 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
1069 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
1070 case SQLITE_READ : zCode="SQLITE_READ"; break;
1071 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
1072 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
1073 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
1074 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
1075 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
1076 case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;
1077 case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;
1078 case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;
1079 case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;
1080 case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;
1081 case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;
1082 case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break;
1083 case SQLITE_RECURSIVE : zCode="SQLITE_RECURSIVE"; break;
1084 default : zCode="????"; break;
1086 Tcl_DStringInit(&str);
1087 Tcl_DStringAppend(&str, pDb->zAuth, -1);
1088 Tcl_DStringAppendElement(&str, zCode);
1089 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
1090 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
1091 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
1092 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
1093 #ifdef SQLITE_USER_AUTHENTICATION
1094 Tcl_DStringAppendElement(&str, zArg5 ? zArg5 : "");
1095 #endif
1096 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
1097 Tcl_DStringFree(&str);
1098 zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY";
1099 if( strcmp(zReply,"SQLITE_OK")==0 ){
1100 rc = SQLITE_OK;
1101 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
1102 rc = SQLITE_DENY;
1103 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
1104 rc = SQLITE_IGNORE;
1105 }else{
1106 rc = 999;
1108 return rc;
1110 #endif /* SQLITE_OMIT_AUTHORIZATION */
1113 ** This routine reads a line of text from FILE in, stores
1114 ** the text in memory obtained from malloc() and returns a pointer
1115 ** to the text. NULL is returned at end of file, or if malloc()
1116 ** fails.
1118 ** The interface is like "readline" but no command-line editing
1119 ** is done.
1121 ** copied from shell.c from '.import' command
1123 static char *local_getline(char *zPrompt, FILE *in){
1124 char *zLine;
1125 int nLine;
1126 int n;
1128 nLine = 100;
1129 zLine = malloc( nLine );
1130 if( zLine==0 ) return 0;
1131 n = 0;
1132 while( 1 ){
1133 if( n+100>nLine ){
1134 nLine = nLine*2 + 100;
1135 zLine = realloc(zLine, nLine);
1136 if( zLine==0 ) return 0;
1138 if( fgets(&zLine[n], nLine - n, in)==0 ){
1139 if( n==0 ){
1140 free(zLine);
1141 return 0;
1143 zLine[n] = 0;
1144 break;
1146 while( zLine[n] ){ n++; }
1147 if( n>0 && zLine[n-1]=='\n' ){
1148 n--;
1149 zLine[n] = 0;
1150 break;
1153 zLine = realloc( zLine, n+1 );
1154 return zLine;
1159 ** This function is part of the implementation of the command:
1161 ** $db transaction [-deferred|-immediate|-exclusive] SCRIPT
1163 ** It is invoked after evaluating the script SCRIPT to commit or rollback
1164 ** the transaction or savepoint opened by the [transaction] command.
1166 static int SQLITE_TCLAPI DbTransPostCmd(
1167 ClientData data[], /* data[0] is the Sqlite3Db* for $db */
1168 Tcl_Interp *interp, /* Tcl interpreter */
1169 int result /* Result of evaluating SCRIPT */
1171 static const char *const azEnd[] = {
1172 "RELEASE _tcl_transaction", /* rc==TCL_ERROR, nTransaction!=0 */
1173 "COMMIT", /* rc!=TCL_ERROR, nTransaction==0 */
1174 "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
1175 "ROLLBACK" /* rc==TCL_ERROR, nTransaction==0 */
1177 SqliteDb *pDb = (SqliteDb*)data[0];
1178 int rc = result;
1179 const char *zEnd;
1181 pDb->nTransaction--;
1182 zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)];
1184 pDb->disableAuth++;
1185 if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
1186 /* This is a tricky scenario to handle. The most likely cause of an
1187 ** error is that the exec() above was an attempt to commit the
1188 ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
1189 ** that an IO-error has occurred. In either case, throw a Tcl exception
1190 ** and try to rollback the transaction.
1192 ** But it could also be that the user executed one or more BEGIN,
1193 ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
1194 ** this method's logic. Not clear how this would be best handled.
1196 if( rc!=TCL_ERROR ){
1197 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
1198 rc = TCL_ERROR;
1200 sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
1202 pDb->disableAuth--;
1204 return rc;
1208 ** Unless SQLITE_TEST is defined, this function is a simple wrapper around
1209 ** sqlite3_prepare_v2(). If SQLITE_TEST is defined, then it uses either
1210 ** sqlite3_prepare_v2() or legacy interface sqlite3_prepare(), depending
1211 ** on whether or not the [db_use_legacy_prepare] command has been used to
1212 ** configure the connection.
1214 static int dbPrepare(
1215 SqliteDb *pDb, /* Database object */
1216 const char *zSql, /* SQL to compile */
1217 sqlite3_stmt **ppStmt, /* OUT: Prepared statement */
1218 const char **pzOut /* OUT: Pointer to next SQL statement */
1220 unsigned int prepFlags = 0;
1221 #ifdef SQLITE_TEST
1222 if( pDb->bLegacyPrepare ){
1223 return sqlite3_prepare(pDb->db, zSql, -1, ppStmt, pzOut);
1225 #endif
1226 /* If the statement cache is large, use the SQLITE_PREPARE_PERSISTENT
1227 ** flags, which uses less lookaside memory. But if the cache is small,
1228 ** omit that flag to make full use of lookaside */
1229 if( pDb->maxStmt>5 ) prepFlags = SQLITE_PREPARE_PERSISTENT;
1231 return sqlite3_prepare_v3(pDb->db, zSql, -1, prepFlags, ppStmt, pzOut);
1235 ** Search the cache for a prepared-statement object that implements the
1236 ** first SQL statement in the buffer pointed to by parameter zIn. If
1237 ** no such prepared-statement can be found, allocate and prepare a new
1238 ** one. In either case, bind the current values of the relevant Tcl
1239 ** variables to any $var, :var or @var variables in the statement. Before
1240 ** returning, set *ppPreStmt to point to the prepared-statement object.
1242 ** Output parameter *pzOut is set to point to the next SQL statement in
1243 ** buffer zIn, or to the '\0' byte at the end of zIn if there is no
1244 ** next statement.
1246 ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned
1247 ** and an error message loaded into interpreter pDb->interp.
1249 static int dbPrepareAndBind(
1250 SqliteDb *pDb, /* Database object */
1251 char const *zIn, /* SQL to compile */
1252 char const **pzOut, /* OUT: Pointer to next SQL statement */
1253 SqlPreparedStmt **ppPreStmt /* OUT: Object used to cache statement */
1255 const char *zSql = zIn; /* Pointer to first SQL statement in zIn */
1256 sqlite3_stmt *pStmt = 0; /* Prepared statement object */
1257 SqlPreparedStmt *pPreStmt; /* Pointer to cached statement */
1258 int nSql; /* Length of zSql in bytes */
1259 int nVar = 0; /* Number of variables in statement */
1260 int iParm = 0; /* Next free entry in apParm */
1261 char c;
1262 int i;
1263 Tcl_Interp *interp = pDb->interp;
1265 *ppPreStmt = 0;
1267 /* Trim spaces from the start of zSql and calculate the remaining length. */
1268 while( (c = zSql[0])==' ' || c=='\t' || c=='\r' || c=='\n' ){ zSql++; }
1269 nSql = strlen30(zSql);
1271 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
1272 int n = pPreStmt->nSql;
1273 if( nSql>=n
1274 && memcmp(pPreStmt->zSql, zSql, n)==0
1275 && (zSql[n]==0 || zSql[n-1]==';')
1277 pStmt = pPreStmt->pStmt;
1278 *pzOut = &zSql[pPreStmt->nSql];
1280 /* When a prepared statement is found, unlink it from the
1281 ** cache list. It will later be added back to the beginning
1282 ** of the cache list in order to implement LRU replacement.
1284 if( pPreStmt->pPrev ){
1285 pPreStmt->pPrev->pNext = pPreStmt->pNext;
1286 }else{
1287 pDb->stmtList = pPreStmt->pNext;
1289 if( pPreStmt->pNext ){
1290 pPreStmt->pNext->pPrev = pPreStmt->pPrev;
1291 }else{
1292 pDb->stmtLast = pPreStmt->pPrev;
1294 pDb->nStmt--;
1295 nVar = sqlite3_bind_parameter_count(pStmt);
1296 break;
1300 /* If no prepared statement was found. Compile the SQL text. Also allocate
1301 ** a new SqlPreparedStmt structure. */
1302 if( pPreStmt==0 ){
1303 int nByte;
1305 if( SQLITE_OK!=dbPrepare(pDb, zSql, &pStmt, pzOut) ){
1306 Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1307 return TCL_ERROR;
1309 if( pStmt==0 ){
1310 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
1311 /* A compile-time error in the statement. */
1312 Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1313 return TCL_ERROR;
1314 }else{
1315 /* The statement was a no-op. Continue to the next statement
1316 ** in the SQL string.
1318 return TCL_OK;
1322 assert( pPreStmt==0 );
1323 nVar = sqlite3_bind_parameter_count(pStmt);
1324 nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *);
1325 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte);
1326 memset(pPreStmt, 0, nByte);
1328 pPreStmt->pStmt = pStmt;
1329 pPreStmt->nSql = (int)(*pzOut - zSql);
1330 pPreStmt->zSql = sqlite3_sql(pStmt);
1331 pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1];
1332 #ifdef SQLITE_TEST
1333 if( pPreStmt->zSql==0 ){
1334 char *zCopy = Tcl_Alloc(pPreStmt->nSql + 1);
1335 memcpy(zCopy, zSql, pPreStmt->nSql);
1336 zCopy[pPreStmt->nSql] = '\0';
1337 pPreStmt->zSql = zCopy;
1339 #endif
1341 assert( pPreStmt );
1342 assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
1343 assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
1345 /* Bind values to parameters that begin with $ or : */
1346 for(i=1; i<=nVar; i++){
1347 const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
1348 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
1349 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
1350 if( pVar ){
1351 int n;
1352 u8 *data;
1353 const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
1354 c = zType[0];
1355 if( zVar[0]=='@' ||
1356 (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
1357 /* Load a BLOB type if the Tcl variable is a bytearray and
1358 ** it has no string representation or the host
1359 ** parameter name begins with "@". */
1360 data = Tcl_GetByteArrayFromObj(pVar, &n);
1361 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
1362 Tcl_IncrRefCount(pVar);
1363 pPreStmt->apParm[iParm++] = pVar;
1364 }else if( c=='b' && strcmp(zType,"boolean")==0 ){
1365 Tcl_GetIntFromObj(interp, pVar, &n);
1366 sqlite3_bind_int(pStmt, i, n);
1367 }else if( c=='d' && strcmp(zType,"double")==0 ){
1368 double r;
1369 Tcl_GetDoubleFromObj(interp, pVar, &r);
1370 sqlite3_bind_double(pStmt, i, r);
1371 }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
1372 (c=='i' && strcmp(zType,"int")==0) ){
1373 Tcl_WideInt v;
1374 Tcl_GetWideIntFromObj(interp, pVar, &v);
1375 sqlite3_bind_int64(pStmt, i, v);
1376 }else{
1377 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
1378 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
1379 Tcl_IncrRefCount(pVar);
1380 pPreStmt->apParm[iParm++] = pVar;
1382 }else{
1383 sqlite3_bind_null(pStmt, i);
1387 pPreStmt->nParm = iParm;
1388 *ppPreStmt = pPreStmt;
1390 return TCL_OK;
1394 ** Release a statement reference obtained by calling dbPrepareAndBind().
1395 ** There should be exactly one call to this function for each call to
1396 ** dbPrepareAndBind().
1398 ** If the discard parameter is non-zero, then the statement is deleted
1399 ** immediately. Otherwise it is added to the LRU list and may be returned
1400 ** by a subsequent call to dbPrepareAndBind().
1402 static void dbReleaseStmt(
1403 SqliteDb *pDb, /* Database handle */
1404 SqlPreparedStmt *pPreStmt, /* Prepared statement handle to release */
1405 int discard /* True to delete (not cache) the pPreStmt */
1407 int i;
1409 /* Free the bound string and blob parameters */
1410 for(i=0; i<pPreStmt->nParm; i++){
1411 Tcl_DecrRefCount(pPreStmt->apParm[i]);
1413 pPreStmt->nParm = 0;
1415 if( pDb->maxStmt<=0 || discard ){
1416 /* If the cache is turned off, deallocated the statement */
1417 dbFreeStmt(pPreStmt);
1418 }else{
1419 /* Add the prepared statement to the beginning of the cache list. */
1420 pPreStmt->pNext = pDb->stmtList;
1421 pPreStmt->pPrev = 0;
1422 if( pDb->stmtList ){
1423 pDb->stmtList->pPrev = pPreStmt;
1425 pDb->stmtList = pPreStmt;
1426 if( pDb->stmtLast==0 ){
1427 assert( pDb->nStmt==0 );
1428 pDb->stmtLast = pPreStmt;
1429 }else{
1430 assert( pDb->nStmt>0 );
1432 pDb->nStmt++;
1434 /* If we have too many statement in cache, remove the surplus from
1435 ** the end of the cache list. */
1436 while( pDb->nStmt>pDb->maxStmt ){
1437 SqlPreparedStmt *pLast = pDb->stmtLast;
1438 pDb->stmtLast = pLast->pPrev;
1439 pDb->stmtLast->pNext = 0;
1440 pDb->nStmt--;
1441 dbFreeStmt(pLast);
1447 ** Structure used with dbEvalXXX() functions:
1449 ** dbEvalInit()
1450 ** dbEvalStep()
1451 ** dbEvalFinalize()
1452 ** dbEvalRowInfo()
1453 ** dbEvalColumnValue()
1455 typedef struct DbEvalContext DbEvalContext;
1456 struct DbEvalContext {
1457 SqliteDb *pDb; /* Database handle */
1458 Tcl_Obj *pSql; /* Object holding string zSql */
1459 const char *zSql; /* Remaining SQL to execute */
1460 SqlPreparedStmt *pPreStmt; /* Current statement */
1461 int nCol; /* Number of columns returned by pStmt */
1462 int evalFlags; /* Flags used */
1463 Tcl_Obj *pArray; /* Name of array variable */
1464 Tcl_Obj **apColName; /* Array of column names */
1467 #define SQLITE_EVAL_WITHOUTNULLS 0x00001 /* Unset array(*) for NULL */
1470 ** Release any cache of column names currently held as part of
1471 ** the DbEvalContext structure passed as the first argument.
1473 static void dbReleaseColumnNames(DbEvalContext *p){
1474 if( p->apColName ){
1475 int i;
1476 for(i=0; i<p->nCol; i++){
1477 Tcl_DecrRefCount(p->apColName[i]);
1479 Tcl_Free((char *)p->apColName);
1480 p->apColName = 0;
1482 p->nCol = 0;
1486 ** Initialize a DbEvalContext structure.
1488 ** If pArray is not NULL, then it contains the name of a Tcl array
1489 ** variable. The "*" member of this array is set to a list containing
1490 ** the names of the columns returned by the statement as part of each
1491 ** call to dbEvalStep(), in order from left to right. e.g. if the names
1492 ** of the returned columns are a, b and c, it does the equivalent of the
1493 ** tcl command:
1495 ** set ${pArray}(*) {a b c}
1497 static void dbEvalInit(
1498 DbEvalContext *p, /* Pointer to structure to initialize */
1499 SqliteDb *pDb, /* Database handle */
1500 Tcl_Obj *pSql, /* Object containing SQL script */
1501 Tcl_Obj *pArray, /* Name of Tcl array to set (*) element of */
1502 int evalFlags /* Flags controlling evaluation */
1504 memset(p, 0, sizeof(DbEvalContext));
1505 p->pDb = pDb;
1506 p->zSql = Tcl_GetString(pSql);
1507 p->pSql = pSql;
1508 Tcl_IncrRefCount(pSql);
1509 if( pArray ){
1510 p->pArray = pArray;
1511 Tcl_IncrRefCount(pArray);
1513 p->evalFlags = evalFlags;
1517 ** Obtain information about the row that the DbEvalContext passed as the
1518 ** first argument currently points to.
1520 static void dbEvalRowInfo(
1521 DbEvalContext *p, /* Evaluation context */
1522 int *pnCol, /* OUT: Number of column names */
1523 Tcl_Obj ***papColName /* OUT: Array of column names */
1525 /* Compute column names */
1526 if( 0==p->apColName ){
1527 sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1528 int i; /* Iterator variable */
1529 int nCol; /* Number of columns returned by pStmt */
1530 Tcl_Obj **apColName = 0; /* Array of column names */
1532 p->nCol = nCol = sqlite3_column_count(pStmt);
1533 if( nCol>0 && (papColName || p->pArray) ){
1534 apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
1535 for(i=0; i<nCol; i++){
1536 apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
1537 Tcl_IncrRefCount(apColName[i]);
1539 p->apColName = apColName;
1542 /* If results are being stored in an array variable, then create
1543 ** the array(*) entry for that array
1545 if( p->pArray ){
1546 Tcl_Interp *interp = p->pDb->interp;
1547 Tcl_Obj *pColList = Tcl_NewObj();
1548 Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
1550 for(i=0; i<nCol; i++){
1551 Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
1553 Tcl_IncrRefCount(pStar);
1554 Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
1555 Tcl_DecrRefCount(pStar);
1559 if( papColName ){
1560 *papColName = p->apColName;
1562 if( pnCol ){
1563 *pnCol = p->nCol;
1568 ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is
1569 ** returned, then an error message is stored in the interpreter before
1570 ** returning.
1572 ** A return value of TCL_OK means there is a row of data available. The
1573 ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
1574 ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK
1575 ** is returned, then the SQL script has finished executing and there are
1576 ** no further rows available. This is similar to SQLITE_DONE.
1578 static int dbEvalStep(DbEvalContext *p){
1579 const char *zPrevSql = 0; /* Previous value of p->zSql */
1581 while( p->zSql[0] || p->pPreStmt ){
1582 int rc;
1583 if( p->pPreStmt==0 ){
1584 zPrevSql = (p->zSql==zPrevSql ? 0 : p->zSql);
1585 rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
1586 if( rc!=TCL_OK ) return rc;
1587 }else{
1588 int rcs;
1589 SqliteDb *pDb = p->pDb;
1590 SqlPreparedStmt *pPreStmt = p->pPreStmt;
1591 sqlite3_stmt *pStmt = pPreStmt->pStmt;
1593 rcs = sqlite3_step(pStmt);
1594 if( rcs==SQLITE_ROW ){
1595 return TCL_OK;
1597 if( p->pArray ){
1598 dbEvalRowInfo(p, 0, 0);
1600 rcs = sqlite3_reset(pStmt);
1602 pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
1603 pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
1604 pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);
1605 pDb->nVMStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_VM_STEP,1);
1606 dbReleaseColumnNames(p);
1607 p->pPreStmt = 0;
1609 if( rcs!=SQLITE_OK ){
1610 /* If a run-time error occurs, report the error and stop reading
1611 ** the SQL. */
1612 dbReleaseStmt(pDb, pPreStmt, 1);
1613 #if SQLITE_TEST
1614 if( p->pDb->bLegacyPrepare && rcs==SQLITE_SCHEMA && zPrevSql ){
1615 /* If the runtime error was an SQLITE_SCHEMA, and the database
1616 ** handle is configured to use the legacy sqlite3_prepare()
1617 ** interface, retry prepare()/step() on the same SQL statement.
1618 ** This only happens once. If there is a second SQLITE_SCHEMA
1619 ** error, the error will be returned to the caller. */
1620 p->zSql = zPrevSql;
1621 continue;
1623 #endif
1624 Tcl_SetObjResult(pDb->interp,
1625 Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1626 return TCL_ERROR;
1627 }else{
1628 dbReleaseStmt(pDb, pPreStmt, 0);
1633 /* Finished */
1634 return TCL_BREAK;
1638 ** Free all resources currently held by the DbEvalContext structure passed
1639 ** as the first argument. There should be exactly one call to this function
1640 ** for each call to dbEvalInit().
1642 static void dbEvalFinalize(DbEvalContext *p){
1643 if( p->pPreStmt ){
1644 sqlite3_reset(p->pPreStmt->pStmt);
1645 dbReleaseStmt(p->pDb, p->pPreStmt, 0);
1646 p->pPreStmt = 0;
1648 if( p->pArray ){
1649 Tcl_DecrRefCount(p->pArray);
1650 p->pArray = 0;
1652 Tcl_DecrRefCount(p->pSql);
1653 dbReleaseColumnNames(p);
1657 ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains
1658 ** the value for the iCol'th column of the row currently pointed to by
1659 ** the DbEvalContext structure passed as the first argument.
1661 static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){
1662 sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1663 switch( sqlite3_column_type(pStmt, iCol) ){
1664 case SQLITE_BLOB: {
1665 int bytes = sqlite3_column_bytes(pStmt, iCol);
1666 const char *zBlob = sqlite3_column_blob(pStmt, iCol);
1667 if( !zBlob ) bytes = 0;
1668 return Tcl_NewByteArrayObj((u8*)zBlob, bytes);
1670 case SQLITE_INTEGER: {
1671 sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
1672 if( v>=-2147483647 && v<=2147483647 ){
1673 return Tcl_NewIntObj((int)v);
1674 }else{
1675 return Tcl_NewWideIntObj(v);
1678 case SQLITE_FLOAT: {
1679 return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
1681 case SQLITE_NULL: {
1682 return Tcl_NewStringObj(p->pDb->zNull, -1);
1686 return Tcl_NewStringObj((char*)sqlite3_column_text(pStmt, iCol), -1);
1690 ** If using Tcl version 8.6 or greater, use the NR functions to avoid
1691 ** recursive evalution of scripts by the [db eval] and [db trans]
1692 ** commands. Even if the headers used while compiling the extension
1693 ** are 8.6 or newer, the code still tests the Tcl version at runtime.
1694 ** This allows stubs-enabled builds to be used with older Tcl libraries.
1696 #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
1697 # define SQLITE_TCL_NRE 1
1698 static int DbUseNre(void){
1699 int major, minor;
1700 Tcl_GetVersion(&major, &minor, 0, 0);
1701 return( (major==8 && minor>=6) || major>8 );
1703 #else
1705 ** Compiling using headers earlier than 8.6. In this case NR cannot be
1706 ** used, so DbUseNre() to always return zero. Add #defines for the other
1707 ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
1708 ** even though the only invocations of them are within conditional blocks
1709 ** of the form:
1711 ** if( DbUseNre() ) { ... }
1713 # define SQLITE_TCL_NRE 0
1714 # define DbUseNre() 0
1715 # define Tcl_NRAddCallback(a,b,c,d,e,f) (void)0
1716 # define Tcl_NREvalObj(a,b,c) 0
1717 # define Tcl_NRCreateCommand(a,b,c,d,e,f) (void)0
1718 #endif
1721 ** This function is part of the implementation of the command:
1723 ** $db eval SQL ?ARRAYNAME? SCRIPT
1725 static int SQLITE_TCLAPI DbEvalNextCmd(
1726 ClientData data[], /* data[0] is the (DbEvalContext*) */
1727 Tcl_Interp *interp, /* Tcl interpreter */
1728 int result /* Result so far */
1730 int rc = result; /* Return code */
1732 /* The first element of the data[] array is a pointer to a DbEvalContext
1733 ** structure allocated using Tcl_Alloc(). The second element of data[]
1734 ** is a pointer to a Tcl_Obj containing the script to run for each row
1735 ** returned by the queries encapsulated in data[0]. */
1736 DbEvalContext *p = (DbEvalContext *)data[0];
1737 Tcl_Obj *pScript = (Tcl_Obj *)data[1];
1738 Tcl_Obj *pArray = p->pArray;
1740 while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
1741 int i;
1742 int nCol;
1743 Tcl_Obj **apColName;
1744 dbEvalRowInfo(p, &nCol, &apColName);
1745 for(i=0; i<nCol; i++){
1746 if( pArray==0 ){
1747 Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
1748 }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
1749 && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL
1751 Tcl_UnsetVar2(interp, Tcl_GetString(pArray),
1752 Tcl_GetString(apColName[i]), 0);
1753 }else{
1754 Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
1758 /* The required interpreter variables are now populated with the data
1759 ** from the current row. If using NRE, schedule callbacks to evaluate
1760 ** script pScript, then to invoke this function again to fetch the next
1761 ** row (or clean up if there is no next row or the script throws an
1762 ** exception). After scheduling the callbacks, return control to the
1763 ** caller.
1765 ** If not using NRE, evaluate pScript directly and continue with the
1766 ** next iteration of this while(...) loop. */
1767 if( DbUseNre() ){
1768 Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0);
1769 return Tcl_NREvalObj(interp, pScript, 0);
1770 }else{
1771 rc = Tcl_EvalObjEx(interp, pScript, 0);
1775 Tcl_DecrRefCount(pScript);
1776 dbEvalFinalize(p);
1777 Tcl_Free((char *)p);
1779 if( rc==TCL_OK || rc==TCL_BREAK ){
1780 Tcl_ResetResult(interp);
1781 rc = TCL_OK;
1783 return rc;
1787 ** This function is used by the implementations of the following database
1788 ** handle sub-commands:
1790 ** $db update_hook ?SCRIPT?
1791 ** $db wal_hook ?SCRIPT?
1792 ** $db commit_hook ?SCRIPT?
1793 ** $db preupdate hook ?SCRIPT?
1795 static void DbHookCmd(
1796 Tcl_Interp *interp, /* Tcl interpreter */
1797 SqliteDb *pDb, /* Database handle */
1798 Tcl_Obj *pArg, /* SCRIPT argument (or NULL) */
1799 Tcl_Obj **ppHook /* Pointer to member of SqliteDb */
1801 sqlite3 *db = pDb->db;
1803 if( *ppHook ){
1804 Tcl_SetObjResult(interp, *ppHook);
1805 if( pArg ){
1806 Tcl_DecrRefCount(*ppHook);
1807 *ppHook = 0;
1810 if( pArg ){
1811 assert( !(*ppHook) );
1812 if( Tcl_GetCharLength(pArg)>0 ){
1813 *ppHook = pArg;
1814 Tcl_IncrRefCount(*ppHook);
1818 #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
1819 sqlite3_preupdate_hook(db, (pDb->pPreUpdateHook?DbPreUpdateHandler:0), pDb);
1820 #endif
1821 sqlite3_update_hook(db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
1822 sqlite3_rollback_hook(db, (pDb->pRollbackHook?DbRollbackHandler:0), pDb);
1823 sqlite3_wal_hook(db, (pDb->pWalHook?DbWalHandler:0), pDb);
1827 ** The "sqlite" command below creates a new Tcl command for each
1828 ** connection it opens to an SQLite database. This routine is invoked
1829 ** whenever one of those connection-specific commands is executed
1830 ** in Tcl. For example, if you run Tcl code like this:
1832 ** sqlite3 db1 "my_database"
1833 ** db1 close
1835 ** The first command opens a connection to the "my_database" database
1836 ** and calls that connection "db1". The second command causes this
1837 ** subroutine to be invoked.
1839 static int SQLITE_TCLAPI DbObjCmd(
1840 void *cd,
1841 Tcl_Interp *interp,
1842 int objc,
1843 Tcl_Obj *const*objv
1845 SqliteDb *pDb = (SqliteDb*)cd;
1846 int choice;
1847 int rc = TCL_OK;
1848 static const char *DB_strs[] = {
1849 "authorizer", "backup", "busy",
1850 "cache", "changes", "close",
1851 "collate", "collation_needed", "commit_hook",
1852 "complete", "copy", "enable_load_extension",
1853 "errorcode", "eval", "exists",
1854 "function", "incrblob", "interrupt",
1855 "last_insert_rowid", "nullvalue", "onecolumn",
1856 "preupdate", "profile", "progress",
1857 "rekey", "restore", "rollback_hook",
1858 "status", "timeout", "total_changes",
1859 "trace", "trace_v2", "transaction",
1860 "unlock_notify", "update_hook", "version",
1861 "wal_hook",
1864 enum DB_enum {
1865 DB_AUTHORIZER, DB_BACKUP, DB_BUSY,
1866 DB_CACHE, DB_CHANGES, DB_CLOSE,
1867 DB_COLLATE, DB_COLLATION_NEEDED, DB_COMMIT_HOOK,
1868 DB_COMPLETE, DB_COPY, DB_ENABLE_LOAD_EXTENSION,
1869 DB_ERRORCODE, DB_EVAL, DB_EXISTS,
1870 DB_FUNCTION, DB_INCRBLOB, DB_INTERRUPT,
1871 DB_LAST_INSERT_ROWID, DB_NULLVALUE, DB_ONECOLUMN,
1872 DB_PREUPDATE, DB_PROFILE, DB_PROGRESS,
1873 DB_REKEY, DB_RESTORE, DB_ROLLBACK_HOOK,
1874 DB_STATUS, DB_TIMEOUT, DB_TOTAL_CHANGES,
1875 DB_TRACE, DB_TRACE_V2, DB_TRANSACTION,
1876 DB_UNLOCK_NOTIFY, DB_UPDATE_HOOK, DB_VERSION,
1877 DB_WAL_HOOK,
1879 /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
1881 if( objc<2 ){
1882 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
1883 return TCL_ERROR;
1885 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
1886 return TCL_ERROR;
1889 switch( (enum DB_enum)choice ){
1891 /* $db authorizer ?CALLBACK?
1893 ** Invoke the given callback to authorize each SQL operation as it is
1894 ** compiled. 5 arguments are appended to the callback before it is
1895 ** invoked:
1897 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
1898 ** (2) First descriptive name (depends on authorization type)
1899 ** (3) Second descriptive name
1900 ** (4) Name of the database (ex: "main", "temp")
1901 ** (5) Name of trigger that is doing the access
1903 ** The callback should return on of the following strings: SQLITE_OK,
1904 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
1906 ** If this method is invoked with no arguments, the current authorization
1907 ** callback string is returned.
1909 case DB_AUTHORIZER: {
1910 #ifdef SQLITE_OMIT_AUTHORIZATION
1911 Tcl_AppendResult(interp, "authorization not available in this build",
1912 (char*)0);
1913 return TCL_ERROR;
1914 #else
1915 if( objc>3 ){
1916 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
1917 return TCL_ERROR;
1918 }else if( objc==2 ){
1919 if( pDb->zAuth ){
1920 Tcl_AppendResult(interp, pDb->zAuth, (char*)0);
1922 }else{
1923 char *zAuth;
1924 int len;
1925 if( pDb->zAuth ){
1926 Tcl_Free(pDb->zAuth);
1928 zAuth = Tcl_GetStringFromObj(objv[2], &len);
1929 if( zAuth && len>0 ){
1930 pDb->zAuth = Tcl_Alloc( len + 1 );
1931 memcpy(pDb->zAuth, zAuth, len+1);
1932 }else{
1933 pDb->zAuth = 0;
1935 if( pDb->zAuth ){
1936 typedef int (*sqlite3_auth_cb)(
1937 void*,int,const char*,const char*,
1938 const char*,const char*);
1939 pDb->interp = interp;
1940 sqlite3_set_authorizer(pDb->db,(sqlite3_auth_cb)auth_callback,pDb);
1941 }else{
1942 sqlite3_set_authorizer(pDb->db, 0, 0);
1945 #endif
1946 break;
1949 /* $db backup ?DATABASE? FILENAME
1951 ** Open or create a database file named FILENAME. Transfer the
1952 ** content of local database DATABASE (default: "main") into the
1953 ** FILENAME database.
1955 case DB_BACKUP: {
1956 const char *zDestFile;
1957 const char *zSrcDb;
1958 sqlite3 *pDest;
1959 sqlite3_backup *pBackup;
1961 if( objc==3 ){
1962 zSrcDb = "main";
1963 zDestFile = Tcl_GetString(objv[2]);
1964 }else if( objc==4 ){
1965 zSrcDb = Tcl_GetString(objv[2]);
1966 zDestFile = Tcl_GetString(objv[3]);
1967 }else{
1968 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
1969 return TCL_ERROR;
1971 rc = sqlite3_open_v2(zDestFile, &pDest,
1972 SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE| pDb->openFlags, 0);
1973 if( rc!=SQLITE_OK ){
1974 Tcl_AppendResult(interp, "cannot open target database: ",
1975 sqlite3_errmsg(pDest), (char*)0);
1976 sqlite3_close(pDest);
1977 return TCL_ERROR;
1979 pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
1980 if( pBackup==0 ){
1981 Tcl_AppendResult(interp, "backup failed: ",
1982 sqlite3_errmsg(pDest), (char*)0);
1983 sqlite3_close(pDest);
1984 return TCL_ERROR;
1986 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
1987 sqlite3_backup_finish(pBackup);
1988 if( rc==SQLITE_DONE ){
1989 rc = TCL_OK;
1990 }else{
1991 Tcl_AppendResult(interp, "backup failed: ",
1992 sqlite3_errmsg(pDest), (char*)0);
1993 rc = TCL_ERROR;
1995 sqlite3_close(pDest);
1996 break;
1999 /* $db busy ?CALLBACK?
2001 ** Invoke the given callback if an SQL statement attempts to open
2002 ** a locked database file.
2004 case DB_BUSY: {
2005 if( objc>3 ){
2006 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
2007 return TCL_ERROR;
2008 }else if( objc==2 ){
2009 if( pDb->zBusy ){
2010 Tcl_AppendResult(interp, pDb->zBusy, (char*)0);
2012 }else{
2013 char *zBusy;
2014 int len;
2015 if( pDb->zBusy ){
2016 Tcl_Free(pDb->zBusy);
2018 zBusy = Tcl_GetStringFromObj(objv[2], &len);
2019 if( zBusy && len>0 ){
2020 pDb->zBusy = Tcl_Alloc( len + 1 );
2021 memcpy(pDb->zBusy, zBusy, len+1);
2022 }else{
2023 pDb->zBusy = 0;
2025 if( pDb->zBusy ){
2026 pDb->interp = interp;
2027 sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
2028 }else{
2029 sqlite3_busy_handler(pDb->db, 0, 0);
2032 break;
2035 /* $db cache flush
2036 ** $db cache size n
2038 ** Flush the prepared statement cache, or set the maximum number of
2039 ** cached statements.
2041 case DB_CACHE: {
2042 char *subCmd;
2043 int n;
2045 if( objc<=2 ){
2046 Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
2047 return TCL_ERROR;
2049 subCmd = Tcl_GetStringFromObj( objv[2], 0 );
2050 if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
2051 if( objc!=3 ){
2052 Tcl_WrongNumArgs(interp, 2, objv, "flush");
2053 return TCL_ERROR;
2054 }else{
2055 flushStmtCache( pDb );
2057 }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
2058 if( objc!=4 ){
2059 Tcl_WrongNumArgs(interp, 2, objv, "size n");
2060 return TCL_ERROR;
2061 }else{
2062 if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
2063 Tcl_AppendResult( interp, "cannot convert \"",
2064 Tcl_GetStringFromObj(objv[3],0), "\" to integer", (char*)0);
2065 return TCL_ERROR;
2066 }else{
2067 if( n<0 ){
2068 flushStmtCache( pDb );
2069 n = 0;
2070 }else if( n>MAX_PREPARED_STMTS ){
2071 n = MAX_PREPARED_STMTS;
2073 pDb->maxStmt = n;
2076 }else{
2077 Tcl_AppendResult( interp, "bad option \"",
2078 Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size",
2079 (char*)0);
2080 return TCL_ERROR;
2082 break;
2085 /* $db changes
2087 ** Return the number of rows that were modified, inserted, or deleted by
2088 ** the most recent INSERT, UPDATE or DELETE statement, not including
2089 ** any changes made by trigger programs.
2091 case DB_CHANGES: {
2092 Tcl_Obj *pResult;
2093 if( objc!=2 ){
2094 Tcl_WrongNumArgs(interp, 2, objv, "");
2095 return TCL_ERROR;
2097 pResult = Tcl_GetObjResult(interp);
2098 Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
2099 break;
2102 /* $db close
2104 ** Shutdown the database
2106 case DB_CLOSE: {
2107 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
2108 break;
2112 ** $db collate NAME SCRIPT
2114 ** Create a new SQL collation function called NAME. Whenever
2115 ** that function is called, invoke SCRIPT to evaluate the function.
2117 case DB_COLLATE: {
2118 SqlCollate *pCollate;
2119 char *zName;
2120 char *zScript;
2121 int nScript;
2122 if( objc!=4 ){
2123 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
2124 return TCL_ERROR;
2126 zName = Tcl_GetStringFromObj(objv[2], 0);
2127 zScript = Tcl_GetStringFromObj(objv[3], &nScript);
2128 pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
2129 if( pCollate==0 ) return TCL_ERROR;
2130 pCollate->interp = interp;
2131 pCollate->pNext = pDb->pCollate;
2132 pCollate->zScript = (char*)&pCollate[1];
2133 pDb->pCollate = pCollate;
2134 memcpy(pCollate->zScript, zScript, nScript+1);
2135 if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
2136 pCollate, tclSqlCollate) ){
2137 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
2138 return TCL_ERROR;
2140 break;
2144 ** $db collation_needed SCRIPT
2146 ** Create a new SQL collation function called NAME. Whenever
2147 ** that function is called, invoke SCRIPT to evaluate the function.
2149 case DB_COLLATION_NEEDED: {
2150 if( objc!=3 ){
2151 Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
2152 return TCL_ERROR;
2154 if( pDb->pCollateNeeded ){
2155 Tcl_DecrRefCount(pDb->pCollateNeeded);
2157 pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
2158 Tcl_IncrRefCount(pDb->pCollateNeeded);
2159 sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
2160 break;
2163 /* $db commit_hook ?CALLBACK?
2165 ** Invoke the given callback just before committing every SQL transaction.
2166 ** If the callback throws an exception or returns non-zero, then the
2167 ** transaction is aborted. If CALLBACK is an empty string, the callback
2168 ** is disabled.
2170 case DB_COMMIT_HOOK: {
2171 if( objc>3 ){
2172 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2173 return TCL_ERROR;
2174 }else if( objc==2 ){
2175 if( pDb->zCommit ){
2176 Tcl_AppendResult(interp, pDb->zCommit, (char*)0);
2178 }else{
2179 const char *zCommit;
2180 int len;
2181 if( pDb->zCommit ){
2182 Tcl_Free(pDb->zCommit);
2184 zCommit = Tcl_GetStringFromObj(objv[2], &len);
2185 if( zCommit && len>0 ){
2186 pDb->zCommit = Tcl_Alloc( len + 1 );
2187 memcpy(pDb->zCommit, zCommit, len+1);
2188 }else{
2189 pDb->zCommit = 0;
2191 if( pDb->zCommit ){
2192 pDb->interp = interp;
2193 sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
2194 }else{
2195 sqlite3_commit_hook(pDb->db, 0, 0);
2198 break;
2201 /* $db complete SQL
2203 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
2204 ** additional lines of input are needed. This is similar to the
2205 ** built-in "info complete" command of Tcl.
2207 case DB_COMPLETE: {
2208 #ifndef SQLITE_OMIT_COMPLETE
2209 Tcl_Obj *pResult;
2210 int isComplete;
2211 if( objc!=3 ){
2212 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
2213 return TCL_ERROR;
2215 isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
2216 pResult = Tcl_GetObjResult(interp);
2217 Tcl_SetBooleanObj(pResult, isComplete);
2218 #endif
2219 break;
2222 /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
2224 ** Copy data into table from filename, optionally using SEPARATOR
2225 ** as column separators. If a column contains a null string, or the
2226 ** value of NULLINDICATOR, a NULL is inserted for the column.
2227 ** conflict-algorithm is one of the sqlite conflict algorithms:
2228 ** rollback, abort, fail, ignore, replace
2229 ** On success, return the number of lines processed, not necessarily same
2230 ** as 'db changes' due to conflict-algorithm selected.
2232 ** This code is basically an implementation/enhancement of
2233 ** the sqlite3 shell.c ".import" command.
2235 ** This command usage is equivalent to the sqlite2.x COPY statement,
2236 ** which imports file data into a table using the PostgreSQL COPY file format:
2237 ** $db copy $conflit_algo $table_name $filename \t \\N
2239 case DB_COPY: {
2240 char *zTable; /* Insert data into this table */
2241 char *zFile; /* The file from which to extract data */
2242 char *zConflict; /* The conflict algorithm to use */
2243 sqlite3_stmt *pStmt; /* A statement */
2244 int nCol; /* Number of columns in the table */
2245 int nByte; /* Number of bytes in an SQL string */
2246 int i, j; /* Loop counters */
2247 int nSep; /* Number of bytes in zSep[] */
2248 int nNull; /* Number of bytes in zNull[] */
2249 char *zSql; /* An SQL statement */
2250 char *zLine; /* A single line of input from the file */
2251 char **azCol; /* zLine[] broken up into columns */
2252 const char *zCommit; /* How to commit changes */
2253 FILE *in; /* The input file */
2254 int lineno = 0; /* Line number of input file */
2255 char zLineNum[80]; /* Line number print buffer */
2256 Tcl_Obj *pResult; /* interp result */
2258 const char *zSep;
2259 const char *zNull;
2260 if( objc<5 || objc>7 ){
2261 Tcl_WrongNumArgs(interp, 2, objv,
2262 "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
2263 return TCL_ERROR;
2265 if( objc>=6 ){
2266 zSep = Tcl_GetStringFromObj(objv[5], 0);
2267 }else{
2268 zSep = "\t";
2270 if( objc>=7 ){
2271 zNull = Tcl_GetStringFromObj(objv[6], 0);
2272 }else{
2273 zNull = "";
2275 zConflict = Tcl_GetStringFromObj(objv[2], 0);
2276 zTable = Tcl_GetStringFromObj(objv[3], 0);
2277 zFile = Tcl_GetStringFromObj(objv[4], 0);
2278 nSep = strlen30(zSep);
2279 nNull = strlen30(zNull);
2280 if( nSep==0 ){
2281 Tcl_AppendResult(interp,"Error: non-null separator required for copy",
2282 (char*)0);
2283 return TCL_ERROR;
2285 if(strcmp(zConflict, "rollback") != 0 &&
2286 strcmp(zConflict, "abort" ) != 0 &&
2287 strcmp(zConflict, "fail" ) != 0 &&
2288 strcmp(zConflict, "ignore" ) != 0 &&
2289 strcmp(zConflict, "replace" ) != 0 ) {
2290 Tcl_AppendResult(interp, "Error: \"", zConflict,
2291 "\", conflict-algorithm must be one of: rollback, "
2292 "abort, fail, ignore, or replace", (char*)0);
2293 return TCL_ERROR;
2295 zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
2296 if( zSql==0 ){
2297 Tcl_AppendResult(interp, "Error: no such table: ", zTable, (char*)0);
2298 return TCL_ERROR;
2300 nByte = strlen30(zSql);
2301 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
2302 sqlite3_free(zSql);
2303 if( rc ){
2304 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2305 nCol = 0;
2306 }else{
2307 nCol = sqlite3_column_count(pStmt);
2309 sqlite3_finalize(pStmt);
2310 if( nCol==0 ) {
2311 return TCL_ERROR;
2313 zSql = malloc( nByte + 50 + nCol*2 );
2314 if( zSql==0 ) {
2315 Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
2316 return TCL_ERROR;
2318 sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
2319 zConflict, zTable);
2320 j = strlen30(zSql);
2321 for(i=1; i<nCol; i++){
2322 zSql[j++] = ',';
2323 zSql[j++] = '?';
2325 zSql[j++] = ')';
2326 zSql[j] = 0;
2327 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
2328 free(zSql);
2329 if( rc ){
2330 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2331 sqlite3_finalize(pStmt);
2332 return TCL_ERROR;
2334 in = fopen(zFile, "rb");
2335 if( in==0 ){
2336 Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, (char*)0);
2337 sqlite3_finalize(pStmt);
2338 return TCL_ERROR;
2340 azCol = malloc( sizeof(azCol[0])*(nCol+1) );
2341 if( azCol==0 ) {
2342 Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
2343 fclose(in);
2344 return TCL_ERROR;
2346 (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
2347 zCommit = "COMMIT";
2348 while( (zLine = local_getline(0, in))!=0 ){
2349 char *z;
2350 lineno++;
2351 azCol[0] = zLine;
2352 for(i=0, z=zLine; *z; z++){
2353 if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
2354 *z = 0;
2355 i++;
2356 if( i<nCol ){
2357 azCol[i] = &z[nSep];
2358 z += nSep-1;
2362 if( i+1!=nCol ){
2363 char *zErr;
2364 int nErr = strlen30(zFile) + 200;
2365 zErr = malloc(nErr);
2366 if( zErr ){
2367 sqlite3_snprintf(nErr, zErr,
2368 "Error: %s line %d: expected %d columns of data but found %d",
2369 zFile, lineno, nCol, i+1);
2370 Tcl_AppendResult(interp, zErr, (char*)0);
2371 free(zErr);
2373 zCommit = "ROLLBACK";
2374 break;
2376 for(i=0; i<nCol; i++){
2377 /* check for null data, if so, bind as null */
2378 if( (nNull>0 && strcmp(azCol[i], zNull)==0)
2379 || strlen30(azCol[i])==0
2381 sqlite3_bind_null(pStmt, i+1);
2382 }else{
2383 sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
2386 sqlite3_step(pStmt);
2387 rc = sqlite3_reset(pStmt);
2388 free(zLine);
2389 if( rc!=SQLITE_OK ){
2390 Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2391 zCommit = "ROLLBACK";
2392 break;
2395 free(azCol);
2396 fclose(in);
2397 sqlite3_finalize(pStmt);
2398 (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
2400 if( zCommit[0] == 'C' ){
2401 /* success, set result as number of lines processed */
2402 pResult = Tcl_GetObjResult(interp);
2403 Tcl_SetIntObj(pResult, lineno);
2404 rc = TCL_OK;
2405 }else{
2406 /* failure, append lineno where failed */
2407 sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
2408 Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,
2409 (char*)0);
2410 rc = TCL_ERROR;
2412 break;
2416 ** $db enable_load_extension BOOLEAN
2418 ** Turn the extension loading feature on or off. It if off by
2419 ** default.
2421 case DB_ENABLE_LOAD_EXTENSION: {
2422 #ifndef SQLITE_OMIT_LOAD_EXTENSION
2423 int onoff;
2424 if( objc!=3 ){
2425 Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
2426 return TCL_ERROR;
2428 if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
2429 return TCL_ERROR;
2431 sqlite3_enable_load_extension(pDb->db, onoff);
2432 break;
2433 #else
2434 Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
2435 (char*)0);
2436 return TCL_ERROR;
2437 #endif
2441 ** $db errorcode
2443 ** Return the numeric error code that was returned by the most recent
2444 ** call to sqlite3_exec().
2446 case DB_ERRORCODE: {
2447 Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
2448 break;
2452 ** $db exists $sql
2453 ** $db onecolumn $sql
2455 ** The onecolumn method is the equivalent of:
2456 ** lindex [$db eval $sql] 0
2458 case DB_EXISTS:
2459 case DB_ONECOLUMN: {
2460 Tcl_Obj *pResult = 0;
2461 DbEvalContext sEval;
2462 if( objc!=3 ){
2463 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
2464 return TCL_ERROR;
2467 dbEvalInit(&sEval, pDb, objv[2], 0, 0);
2468 rc = dbEvalStep(&sEval);
2469 if( choice==DB_ONECOLUMN ){
2470 if( rc==TCL_OK ){
2471 pResult = dbEvalColumnValue(&sEval, 0);
2472 }else if( rc==TCL_BREAK ){
2473 Tcl_ResetResult(interp);
2475 }else if( rc==TCL_BREAK || rc==TCL_OK ){
2476 pResult = Tcl_NewBooleanObj(rc==TCL_OK);
2478 dbEvalFinalize(&sEval);
2479 if( pResult ) Tcl_SetObjResult(interp, pResult);
2481 if( rc==TCL_BREAK ){
2482 rc = TCL_OK;
2484 break;
2488 ** $db eval ?options? $sql ?array? ?{ ...code... }?
2490 ** The SQL statement in $sql is evaluated. For each row, the values are
2491 ** placed in elements of the array named "array" and ...code... is executed.
2492 ** If "array" and "code" are omitted, then no callback is every invoked.
2493 ** If "array" is an empty string, then the values are placed in variables
2494 ** that have the same name as the fields extracted by the query.
2496 case DB_EVAL: {
2497 int evalFlags = 0;
2498 const char *zOpt;
2499 while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
2500 if( strcmp(zOpt, "-withoutnulls")==0 ){
2501 evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
2503 else{
2504 Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
2505 return TCL_ERROR;
2507 objc--;
2508 objv++;
2510 if( objc<3 || objc>5 ){
2511 Tcl_WrongNumArgs(interp, 2, objv,
2512 "?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?");
2513 return TCL_ERROR;
2516 if( objc==3 ){
2517 DbEvalContext sEval;
2518 Tcl_Obj *pRet = Tcl_NewObj();
2519 Tcl_IncrRefCount(pRet);
2520 dbEvalInit(&sEval, pDb, objv[2], 0, 0);
2521 while( TCL_OK==(rc = dbEvalStep(&sEval)) ){
2522 int i;
2523 int nCol;
2524 dbEvalRowInfo(&sEval, &nCol, 0);
2525 for(i=0; i<nCol; i++){
2526 Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
2529 dbEvalFinalize(&sEval);
2530 if( rc==TCL_BREAK ){
2531 Tcl_SetObjResult(interp, pRet);
2532 rc = TCL_OK;
2534 Tcl_DecrRefCount(pRet);
2535 }else{
2536 ClientData cd2[2];
2537 DbEvalContext *p;
2538 Tcl_Obj *pArray = 0;
2539 Tcl_Obj *pScript;
2541 if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
2542 pArray = objv[3];
2544 pScript = objv[objc-1];
2545 Tcl_IncrRefCount(pScript);
2547 p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
2548 dbEvalInit(p, pDb, objv[2], pArray, evalFlags);
2550 cd2[0] = (void *)p;
2551 cd2[1] = (void *)pScript;
2552 rc = DbEvalNextCmd(cd2, interp, TCL_OK);
2554 break;
2558 ** $db function NAME [-argcount N] [-deterministic] SCRIPT
2560 ** Create a new SQL function called NAME. Whenever that function is
2561 ** called, invoke SCRIPT to evaluate the function.
2563 case DB_FUNCTION: {
2564 int flags = SQLITE_UTF8;
2565 SqlFunc *pFunc;
2566 Tcl_Obj *pScript;
2567 char *zName;
2568 int nArg = -1;
2569 int i;
2570 if( objc<4 ){
2571 Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT");
2572 return TCL_ERROR;
2574 for(i=3; i<(objc-1); i++){
2575 const char *z = Tcl_GetString(objv[i]);
2576 int n = strlen30(z);
2577 if( n>2 && strncmp(z, "-argcount",n)==0 ){
2578 if( i==(objc-2) ){
2579 Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
2580 return TCL_ERROR;
2582 if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR;
2583 if( nArg<0 ){
2584 Tcl_AppendResult(interp, "number of arguments must be non-negative",
2585 (char*)0);
2586 return TCL_ERROR;
2588 i++;
2589 }else
2590 if( n>2 && strncmp(z, "-deterministic",n)==0 ){
2591 flags |= SQLITE_DETERMINISTIC;
2592 }else{
2593 Tcl_AppendResult(interp, "bad option \"", z,
2594 "\": must be -argcount or -deterministic", (char*)0
2596 return TCL_ERROR;
2600 pScript = objv[objc-1];
2601 zName = Tcl_GetStringFromObj(objv[2], 0);
2602 pFunc = findSqlFunc(pDb, zName);
2603 if( pFunc==0 ) return TCL_ERROR;
2604 if( pFunc->pScript ){
2605 Tcl_DecrRefCount(pFunc->pScript);
2607 pFunc->pScript = pScript;
2608 Tcl_IncrRefCount(pScript);
2609 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
2610 rc = sqlite3_create_function(pDb->db, zName, nArg, flags,
2611 pFunc, tclSqlFunc, 0, 0);
2612 if( rc!=SQLITE_OK ){
2613 rc = TCL_ERROR;
2614 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
2616 break;
2620 ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
2622 case DB_INCRBLOB: {
2623 #ifdef SQLITE_OMIT_INCRBLOB
2624 Tcl_AppendResult(interp, "incrblob not available in this build", (char*)0);
2625 return TCL_ERROR;
2626 #else
2627 int isReadonly = 0;
2628 const char *zDb = "main";
2629 const char *zTable;
2630 const char *zColumn;
2631 Tcl_WideInt iRow;
2633 /* Check for the -readonly option */
2634 if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
2635 isReadonly = 1;
2638 if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
2639 Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
2640 return TCL_ERROR;
2643 if( objc==(6+isReadonly) ){
2644 zDb = Tcl_GetString(objv[2]);
2646 zTable = Tcl_GetString(objv[objc-3]);
2647 zColumn = Tcl_GetString(objv[objc-2]);
2648 rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
2650 if( rc==TCL_OK ){
2651 rc = createIncrblobChannel(
2652 interp, pDb, zDb, zTable, zColumn, (sqlite3_int64)iRow, isReadonly
2655 #endif
2656 break;
2660 ** $db interrupt
2662 ** Interrupt the execution of the inner-most SQL interpreter. This
2663 ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
2665 case DB_INTERRUPT: {
2666 sqlite3_interrupt(pDb->db);
2667 break;
2671 ** $db nullvalue ?STRING?
2673 ** Change text used when a NULL comes back from the database. If ?STRING?
2674 ** is not present, then the current string used for NULL is returned.
2675 ** If STRING is present, then STRING is returned.
2678 case DB_NULLVALUE: {
2679 if( objc!=2 && objc!=3 ){
2680 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
2681 return TCL_ERROR;
2683 if( objc==3 ){
2684 int len;
2685 char *zNull = Tcl_GetStringFromObj(objv[2], &len);
2686 if( pDb->zNull ){
2687 Tcl_Free(pDb->zNull);
2689 if( zNull && len>0 ){
2690 pDb->zNull = Tcl_Alloc( len + 1 );
2691 memcpy(pDb->zNull, zNull, len);
2692 pDb->zNull[len] = '\0';
2693 }else{
2694 pDb->zNull = 0;
2697 Tcl_SetObjResult(interp, Tcl_NewStringObj(pDb->zNull, -1));
2698 break;
2702 ** $db last_insert_rowid
2704 ** Return an integer which is the ROWID for the most recent insert.
2706 case DB_LAST_INSERT_ROWID: {
2707 Tcl_Obj *pResult;
2708 Tcl_WideInt rowid;
2709 if( objc!=2 ){
2710 Tcl_WrongNumArgs(interp, 2, objv, "");
2711 return TCL_ERROR;
2713 rowid = sqlite3_last_insert_rowid(pDb->db);
2714 pResult = Tcl_GetObjResult(interp);
2715 Tcl_SetWideIntObj(pResult, rowid);
2716 break;
2720 ** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
2723 /* $db progress ?N CALLBACK?
2725 ** Invoke the given callback every N virtual machine opcodes while executing
2726 ** queries.
2728 case DB_PROGRESS: {
2729 if( objc==2 ){
2730 if( pDb->zProgress ){
2731 Tcl_AppendResult(interp, pDb->zProgress, (char*)0);
2733 }else if( objc==4 ){
2734 char *zProgress;
2735 int len;
2736 int N;
2737 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
2738 return TCL_ERROR;
2740 if( pDb->zProgress ){
2741 Tcl_Free(pDb->zProgress);
2743 zProgress = Tcl_GetStringFromObj(objv[3], &len);
2744 if( zProgress && len>0 ){
2745 pDb->zProgress = Tcl_Alloc( len + 1 );
2746 memcpy(pDb->zProgress, zProgress, len+1);
2747 }else{
2748 pDb->zProgress = 0;
2750 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
2751 if( pDb->zProgress ){
2752 pDb->interp = interp;
2753 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
2754 }else{
2755 sqlite3_progress_handler(pDb->db, 0, 0, 0);
2757 #endif
2758 }else{
2759 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
2760 return TCL_ERROR;
2762 break;
2765 /* $db profile ?CALLBACK?
2767 ** Make arrangements to invoke the CALLBACK routine after each SQL statement
2768 ** that has run. The text of the SQL and the amount of elapse time are
2769 ** appended to CALLBACK before the script is run.
2771 case DB_PROFILE: {
2772 if( objc>3 ){
2773 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2774 return TCL_ERROR;
2775 }else if( objc==2 ){
2776 if( pDb->zProfile ){
2777 Tcl_AppendResult(interp, pDb->zProfile, (char*)0);
2779 }else{
2780 char *zProfile;
2781 int len;
2782 if( pDb->zProfile ){
2783 Tcl_Free(pDb->zProfile);
2785 zProfile = Tcl_GetStringFromObj(objv[2], &len);
2786 if( zProfile && len>0 ){
2787 pDb->zProfile = Tcl_Alloc( len + 1 );
2788 memcpy(pDb->zProfile, zProfile, len+1);
2789 }else{
2790 pDb->zProfile = 0;
2792 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
2793 !defined(SQLITE_OMIT_DEPRECATED)
2794 if( pDb->zProfile ){
2795 pDb->interp = interp;
2796 sqlite3_profile(pDb->db, DbProfileHandler, pDb);
2797 }else{
2798 sqlite3_profile(pDb->db, 0, 0);
2800 #endif
2802 break;
2806 ** $db rekey KEY
2808 ** Change the encryption key on the currently open database.
2810 case DB_REKEY: {
2811 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
2812 int nKey;
2813 void *pKey;
2814 #endif
2815 if( objc!=3 ){
2816 Tcl_WrongNumArgs(interp, 2, objv, "KEY");
2817 return TCL_ERROR;
2819 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
2820 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
2821 rc = sqlite3_rekey(pDb->db, pKey, nKey);
2822 if( rc ){
2823 Tcl_AppendResult(interp, sqlite3_errstr(rc), (char*)0);
2824 rc = TCL_ERROR;
2826 #endif
2827 break;
2830 /* $db restore ?DATABASE? FILENAME
2832 ** Open a database file named FILENAME. Transfer the content
2833 ** of FILENAME into the local database DATABASE (default: "main").
2835 case DB_RESTORE: {
2836 const char *zSrcFile;
2837 const char *zDestDb;
2838 sqlite3 *pSrc;
2839 sqlite3_backup *pBackup;
2840 int nTimeout = 0;
2842 if( objc==3 ){
2843 zDestDb = "main";
2844 zSrcFile = Tcl_GetString(objv[2]);
2845 }else if( objc==4 ){
2846 zDestDb = Tcl_GetString(objv[2]);
2847 zSrcFile = Tcl_GetString(objv[3]);
2848 }else{
2849 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
2850 return TCL_ERROR;
2852 rc = sqlite3_open_v2(zSrcFile, &pSrc,
2853 SQLITE_OPEN_READONLY | pDb->openFlags, 0);
2854 if( rc!=SQLITE_OK ){
2855 Tcl_AppendResult(interp, "cannot open source database: ",
2856 sqlite3_errmsg(pSrc), (char*)0);
2857 sqlite3_close(pSrc);
2858 return TCL_ERROR;
2860 pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
2861 if( pBackup==0 ){
2862 Tcl_AppendResult(interp, "restore failed: ",
2863 sqlite3_errmsg(pDb->db), (char*)0);
2864 sqlite3_close(pSrc);
2865 return TCL_ERROR;
2867 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
2868 || rc==SQLITE_BUSY ){
2869 if( rc==SQLITE_BUSY ){
2870 if( nTimeout++ >= 3 ) break;
2871 sqlite3_sleep(100);
2874 sqlite3_backup_finish(pBackup);
2875 if( rc==SQLITE_DONE ){
2876 rc = TCL_OK;
2877 }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){
2878 Tcl_AppendResult(interp, "restore failed: source database busy",
2879 (char*)0);
2880 rc = TCL_ERROR;
2881 }else{
2882 Tcl_AppendResult(interp, "restore failed: ",
2883 sqlite3_errmsg(pDb->db), (char*)0);
2884 rc = TCL_ERROR;
2886 sqlite3_close(pSrc);
2887 break;
2891 ** $db status (step|sort|autoindex|vmstep)
2893 ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
2894 ** SQLITE_STMTSTATUS_SORT for the most recent eval.
2896 case DB_STATUS: {
2897 int v;
2898 const char *zOp;
2899 if( objc!=3 ){
2900 Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)");
2901 return TCL_ERROR;
2903 zOp = Tcl_GetString(objv[2]);
2904 if( strcmp(zOp, "step")==0 ){
2905 v = pDb->nStep;
2906 }else if( strcmp(zOp, "sort")==0 ){
2907 v = pDb->nSort;
2908 }else if( strcmp(zOp, "autoindex")==0 ){
2909 v = pDb->nIndex;
2910 }else if( strcmp(zOp, "vmstep")==0 ){
2911 v = pDb->nVMStep;
2912 }else{
2913 Tcl_AppendResult(interp,
2914 "bad argument: should be autoindex, step, sort or vmstep",
2915 (char*)0);
2916 return TCL_ERROR;
2918 Tcl_SetObjResult(interp, Tcl_NewIntObj(v));
2919 break;
2923 ** $db timeout MILLESECONDS
2925 ** Delay for the number of milliseconds specified when a file is locked.
2927 case DB_TIMEOUT: {
2928 int ms;
2929 if( objc!=3 ){
2930 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
2931 return TCL_ERROR;
2933 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
2934 sqlite3_busy_timeout(pDb->db, ms);
2935 break;
2939 ** $db total_changes
2941 ** Return the number of rows that were modified, inserted, or deleted
2942 ** since the database handle was created.
2944 case DB_TOTAL_CHANGES: {
2945 Tcl_Obj *pResult;
2946 if( objc!=2 ){
2947 Tcl_WrongNumArgs(interp, 2, objv, "");
2948 return TCL_ERROR;
2950 pResult = Tcl_GetObjResult(interp);
2951 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
2952 break;
2955 /* $db trace ?CALLBACK?
2957 ** Make arrangements to invoke the CALLBACK routine for each SQL statement
2958 ** that is executed. The text of the SQL is appended to CALLBACK before
2959 ** it is executed.
2961 case DB_TRACE: {
2962 if( objc>3 ){
2963 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2964 return TCL_ERROR;
2965 }else if( objc==2 ){
2966 if( pDb->zTrace ){
2967 Tcl_AppendResult(interp, pDb->zTrace, (char*)0);
2969 }else{
2970 char *zTrace;
2971 int len;
2972 if( pDb->zTrace ){
2973 Tcl_Free(pDb->zTrace);
2975 zTrace = Tcl_GetStringFromObj(objv[2], &len);
2976 if( zTrace && len>0 ){
2977 pDb->zTrace = Tcl_Alloc( len + 1 );
2978 memcpy(pDb->zTrace, zTrace, len+1);
2979 }else{
2980 pDb->zTrace = 0;
2982 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
2983 !defined(SQLITE_OMIT_DEPRECATED)
2984 if( pDb->zTrace ){
2985 pDb->interp = interp;
2986 sqlite3_trace(pDb->db, DbTraceHandler, pDb);
2987 }else{
2988 sqlite3_trace(pDb->db, 0, 0);
2990 #endif
2992 break;
2995 /* $db trace_v2 ?CALLBACK? ?MASK?
2997 ** Make arrangements to invoke the CALLBACK routine for each trace event
2998 ** matching the mask that is generated. The parameters are appended to
2999 ** CALLBACK before it is executed.
3001 case DB_TRACE_V2: {
3002 if( objc>4 ){
3003 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK? ?MASK?");
3004 return TCL_ERROR;
3005 }else if( objc==2 ){
3006 if( pDb->zTraceV2 ){
3007 Tcl_AppendResult(interp, pDb->zTraceV2, (char*)0);
3009 }else{
3010 char *zTraceV2;
3011 int len;
3012 Tcl_WideInt wMask = 0;
3013 if( objc==4 ){
3014 static const char *TTYPE_strs[] = {
3015 "statement", "profile", "row", "close", 0
3017 enum TTYPE_enum {
3018 TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE
3020 int i;
3021 if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){
3022 return TCL_ERROR;
3024 for(i=0; i<len; i++){
3025 Tcl_Obj *pObj;
3026 int ttype;
3027 if( TCL_OK!=Tcl_ListObjIndex(interp, objv[3], i, &pObj) ){
3028 return TCL_ERROR;
3030 if( Tcl_GetIndexFromObj(interp, pObj, TTYPE_strs, "trace type",
3031 0, &ttype)!=TCL_OK ){
3032 Tcl_WideInt wType;
3033 Tcl_Obj *pError = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
3034 Tcl_IncrRefCount(pError);
3035 if( TCL_OK==Tcl_GetWideIntFromObj(interp, pObj, &wType) ){
3036 Tcl_DecrRefCount(pError);
3037 wMask |= wType;
3038 }else{
3039 Tcl_SetObjResult(interp, pError);
3040 Tcl_DecrRefCount(pError);
3041 return TCL_ERROR;
3043 }else{
3044 switch( (enum TTYPE_enum)ttype ){
3045 case TTYPE_STMT: wMask |= SQLITE_TRACE_STMT; break;
3046 case TTYPE_PROFILE: wMask |= SQLITE_TRACE_PROFILE; break;
3047 case TTYPE_ROW: wMask |= SQLITE_TRACE_ROW; break;
3048 case TTYPE_CLOSE: wMask |= SQLITE_TRACE_CLOSE; break;
3052 }else{
3053 wMask = SQLITE_TRACE_STMT; /* use the "legacy" default */
3055 if( pDb->zTraceV2 ){
3056 Tcl_Free(pDb->zTraceV2);
3058 zTraceV2 = Tcl_GetStringFromObj(objv[2], &len);
3059 if( zTraceV2 && len>0 ){
3060 pDb->zTraceV2 = Tcl_Alloc( len + 1 );
3061 memcpy(pDb->zTraceV2, zTraceV2, len+1);
3062 }else{
3063 pDb->zTraceV2 = 0;
3065 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
3066 if( pDb->zTraceV2 ){
3067 pDb->interp = interp;
3068 sqlite3_trace_v2(pDb->db, (unsigned)wMask, DbTraceV2Handler, pDb);
3069 }else{
3070 sqlite3_trace_v2(pDb->db, 0, 0, 0);
3072 #endif
3074 break;
3077 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT
3079 ** Start a new transaction (if we are not already in the midst of a
3080 ** transaction) and execute the TCL script SCRIPT. After SCRIPT
3081 ** completes, either commit the transaction or roll it back if SCRIPT
3082 ** throws an exception. Or if no new transation was started, do nothing.
3083 ** pass the exception on up the stack.
3085 ** This command was inspired by Dave Thomas's talk on Ruby at the
3086 ** 2005 O'Reilly Open Source Convention (OSCON).
3088 case DB_TRANSACTION: {
3089 Tcl_Obj *pScript;
3090 const char *zBegin = "SAVEPOINT _tcl_transaction";
3091 if( objc!=3 && objc!=4 ){
3092 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
3093 return TCL_ERROR;
3096 if( pDb->nTransaction==0 && objc==4 ){
3097 static const char *TTYPE_strs[] = {
3098 "deferred", "exclusive", "immediate", 0
3100 enum TTYPE_enum {
3101 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
3103 int ttype;
3104 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
3105 0, &ttype) ){
3106 return TCL_ERROR;
3108 switch( (enum TTYPE_enum)ttype ){
3109 case TTYPE_DEFERRED: /* no-op */; break;
3110 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break;
3111 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break;
3114 pScript = objv[objc-1];
3116 /* Run the SQLite BEGIN command to open a transaction or savepoint. */
3117 pDb->disableAuth++;
3118 rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
3119 pDb->disableAuth--;
3120 if( rc!=SQLITE_OK ){
3121 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3122 return TCL_ERROR;
3124 pDb->nTransaction++;
3126 /* If using NRE, schedule a callback to invoke the script pScript, then
3127 ** a second callback to commit (or rollback) the transaction or savepoint
3128 ** opened above. If not using NRE, evaluate the script directly, then
3129 ** call function DbTransPostCmd() to commit (or rollback) the transaction
3130 ** or savepoint. */
3131 if( DbUseNre() ){
3132 Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0);
3133 (void)Tcl_NREvalObj(interp, pScript, 0);
3134 }else{
3135 rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0));
3137 break;
3141 ** $db unlock_notify ?script?
3143 case DB_UNLOCK_NOTIFY: {
3144 #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
3145 Tcl_AppendResult(interp, "unlock_notify not available in this build",
3146 (char*)0);
3147 rc = TCL_ERROR;
3148 #else
3149 if( objc!=2 && objc!=3 ){
3150 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
3151 rc = TCL_ERROR;
3152 }else{
3153 void (*xNotify)(void **, int) = 0;
3154 void *pNotifyArg = 0;
3156 if( pDb->pUnlockNotify ){
3157 Tcl_DecrRefCount(pDb->pUnlockNotify);
3158 pDb->pUnlockNotify = 0;
3161 if( objc==3 ){
3162 xNotify = DbUnlockNotify;
3163 pNotifyArg = (void *)pDb;
3164 pDb->pUnlockNotify = objv[2];
3165 Tcl_IncrRefCount(pDb->pUnlockNotify);
3168 if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
3169 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3170 rc = TCL_ERROR;
3173 #endif
3174 break;
3178 ** $db preupdate_hook count
3179 ** $db preupdate_hook hook ?SCRIPT?
3180 ** $db preupdate_hook new INDEX
3181 ** $db preupdate_hook old INDEX
3183 case DB_PREUPDATE: {
3184 #ifndef SQLITE_ENABLE_PREUPDATE_HOOK
3185 Tcl_AppendResult(interp, "preupdate_hook was omitted at compile-time",
3186 (char*)0);
3187 rc = TCL_ERROR;
3188 #else
3189 static const char *azSub[] = {"count", "depth", "hook", "new", "old", 0};
3190 enum DbPreupdateSubCmd {
3191 PRE_COUNT, PRE_DEPTH, PRE_HOOK, PRE_NEW, PRE_OLD
3193 int iSub;
3195 if( objc<3 ){
3196 Tcl_WrongNumArgs(interp, 2, objv, "SUB-COMMAND ?ARGS?");
3198 if( Tcl_GetIndexFromObj(interp, objv[2], azSub, "sub-command", 0, &iSub) ){
3199 return TCL_ERROR;
3202 switch( (enum DbPreupdateSubCmd)iSub ){
3203 case PRE_COUNT: {
3204 int nCol = sqlite3_preupdate_count(pDb->db);
3205 Tcl_SetObjResult(interp, Tcl_NewIntObj(nCol));
3206 break;
3209 case PRE_HOOK: {
3210 if( objc>4 ){
3211 Tcl_WrongNumArgs(interp, 2, objv, "hook ?SCRIPT?");
3212 return TCL_ERROR;
3214 DbHookCmd(interp, pDb, (objc==4 ? objv[3] : 0), &pDb->pPreUpdateHook);
3215 break;
3218 case PRE_DEPTH: {
3219 Tcl_Obj *pRet;
3220 if( objc!=3 ){
3221 Tcl_WrongNumArgs(interp, 3, objv, "");
3222 return TCL_ERROR;
3224 pRet = Tcl_NewIntObj(sqlite3_preupdate_depth(pDb->db));
3225 Tcl_SetObjResult(interp, pRet);
3226 break;
3229 case PRE_NEW:
3230 case PRE_OLD: {
3231 int iIdx;
3232 sqlite3_value *pValue;
3233 if( objc!=4 ){
3234 Tcl_WrongNumArgs(interp, 3, objv, "INDEX");
3235 return TCL_ERROR;
3237 if( Tcl_GetIntFromObj(interp, objv[3], &iIdx) ){
3238 return TCL_ERROR;
3241 if( iSub==PRE_OLD ){
3242 rc = sqlite3_preupdate_old(pDb->db, iIdx, &pValue);
3243 }else{
3244 assert( iSub==PRE_NEW );
3245 rc = sqlite3_preupdate_new(pDb->db, iIdx, &pValue);
3248 if( rc==SQLITE_OK ){
3249 Tcl_Obj *pObj;
3250 pObj = Tcl_NewStringObj((char*)sqlite3_value_text(pValue), -1);
3251 Tcl_SetObjResult(interp, pObj);
3252 }else{
3253 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3254 return TCL_ERROR;
3258 #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
3259 break;
3263 ** $db wal_hook ?script?
3264 ** $db update_hook ?script?
3265 ** $db rollback_hook ?script?
3267 case DB_WAL_HOOK:
3268 case DB_UPDATE_HOOK:
3269 case DB_ROLLBACK_HOOK: {
3270 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
3271 ** whether [$db update_hook] or [$db rollback_hook] was invoked.
3273 Tcl_Obj **ppHook = 0;
3274 if( choice==DB_WAL_HOOK ) ppHook = &pDb->pWalHook;
3275 if( choice==DB_UPDATE_HOOK ) ppHook = &pDb->pUpdateHook;
3276 if( choice==DB_ROLLBACK_HOOK ) ppHook = &pDb->pRollbackHook;
3277 if( objc>3 ){
3278 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
3279 return TCL_ERROR;
3282 DbHookCmd(interp, pDb, (objc==3 ? objv[2] : 0), ppHook);
3283 break;
3286 /* $db version
3288 ** Return the version string for this database.
3290 case DB_VERSION: {
3291 int i;
3292 for(i=2; i<objc; i++){
3293 const char *zArg = Tcl_GetString(objv[i]);
3294 /* Optional arguments to $db version are used for testing purpose */
3295 #ifdef SQLITE_TEST
3296 /* $db version -use-legacy-prepare BOOLEAN
3298 ** Turn the use of legacy sqlite3_prepare() on or off.
3300 if( strcmp(zArg, "-use-legacy-prepare")==0 && i+1<objc ){
3301 i++;
3302 if( Tcl_GetBooleanFromObj(interp, objv[i], &pDb->bLegacyPrepare) ){
3303 return TCL_ERROR;
3305 }else
3307 /* $db version -last-stmt-ptr
3309 ** Return a string which is a hex encoding of the pointer to the
3310 ** most recent sqlite3_stmt in the statement cache.
3312 if( strcmp(zArg, "-last-stmt-ptr")==0 ){
3313 char zBuf[100];
3314 sqlite3_snprintf(sizeof(zBuf), zBuf, "%p",
3315 pDb->stmtList ? pDb->stmtList->pStmt: 0);
3316 Tcl_SetResult(interp, zBuf, TCL_VOLATILE);
3317 }else
3318 #endif /* SQLITE_TEST */
3320 Tcl_AppendResult(interp, "unknown argument: ", zArg, (char*)0);
3321 return TCL_ERROR;
3324 if( i==2 ){
3325 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
3327 break;
3331 } /* End of the SWITCH statement */
3332 return rc;
3335 #if SQLITE_TCL_NRE
3337 ** Adaptor that provides an objCmd interface to the NRE-enabled
3338 ** interface implementation.
3340 static int SQLITE_TCLAPI DbObjCmdAdaptor(
3341 void *cd,
3342 Tcl_Interp *interp,
3343 int objc,
3344 Tcl_Obj *const*objv
3346 return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
3348 #endif /* SQLITE_TCL_NRE */
3351 ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
3352 ** ?-create BOOLEAN? ?-nomutex BOOLEAN?
3354 ** This is the main Tcl command. When the "sqlite" Tcl command is
3355 ** invoked, this routine runs to process that command.
3357 ** The first argument, DBNAME, is an arbitrary name for a new
3358 ** database connection. This command creates a new command named
3359 ** DBNAME that is used to control that connection. The database
3360 ** connection is deleted when the DBNAME command is deleted.
3362 ** The second argument is the name of the database file.
3365 static int SQLITE_TCLAPI DbMain(
3366 void *cd,
3367 Tcl_Interp *interp,
3368 int objc,
3369 Tcl_Obj *const*objv
3371 SqliteDb *p;
3372 const char *zArg;
3373 char *zErrMsg;
3374 int i;
3375 const char *zFile;
3376 const char *zVfs = 0;
3377 int flags;
3378 Tcl_DString translatedFilename;
3379 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3380 void *pKey = 0;
3381 int nKey = 0;
3382 #endif
3383 int rc;
3385 /* In normal use, each TCL interpreter runs in a single thread. So
3386 ** by default, we can turn of mutexing on SQLite database connections.
3387 ** However, for testing purposes it is useful to have mutexes turned
3388 ** on. So, by default, mutexes default off. But if compiled with
3389 ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
3391 #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
3392 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
3393 #else
3394 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
3395 #endif
3397 if( objc==2 ){
3398 zArg = Tcl_GetStringFromObj(objv[1], 0);
3399 if( strcmp(zArg,"-version")==0 ){
3400 Tcl_AppendResult(interp,sqlite3_libversion(), (char*)0);
3401 return TCL_OK;
3403 if( strcmp(zArg,"-sourceid")==0 ){
3404 Tcl_AppendResult(interp,sqlite3_sourceid(), (char*)0);
3405 return TCL_OK;
3407 if( strcmp(zArg,"-has-codec")==0 ){
3408 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3409 Tcl_AppendResult(interp,"1",(char*)0);
3410 #else
3411 Tcl_AppendResult(interp,"0",(char*)0);
3412 #endif
3413 return TCL_OK;
3416 for(i=3; i+1<objc; i+=2){
3417 zArg = Tcl_GetString(objv[i]);
3418 if( strcmp(zArg,"-key")==0 ){
3419 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3420 pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey);
3421 #endif
3422 }else if( strcmp(zArg, "-vfs")==0 ){
3423 zVfs = Tcl_GetString(objv[i+1]);
3424 }else if( strcmp(zArg, "-readonly")==0 ){
3425 int b;
3426 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
3427 if( b ){
3428 flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
3429 flags |= SQLITE_OPEN_READONLY;
3430 }else{
3431 flags &= ~SQLITE_OPEN_READONLY;
3432 flags |= SQLITE_OPEN_READWRITE;
3434 }else if( strcmp(zArg, "-create")==0 ){
3435 int b;
3436 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
3437 if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
3438 flags |= SQLITE_OPEN_CREATE;
3439 }else{
3440 flags &= ~SQLITE_OPEN_CREATE;
3442 }else if( strcmp(zArg, "-nomutex")==0 ){
3443 int b;
3444 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
3445 if( b ){
3446 flags |= SQLITE_OPEN_NOMUTEX;
3447 flags &= ~SQLITE_OPEN_FULLMUTEX;
3448 }else{
3449 flags &= ~SQLITE_OPEN_NOMUTEX;
3451 }else if( strcmp(zArg, "-fullmutex")==0 ){
3452 int b;
3453 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
3454 if( b ){
3455 flags |= SQLITE_OPEN_FULLMUTEX;
3456 flags &= ~SQLITE_OPEN_NOMUTEX;
3457 }else{
3458 flags &= ~SQLITE_OPEN_FULLMUTEX;
3460 }else if( strcmp(zArg, "-uri")==0 ){
3461 int b;
3462 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
3463 if( b ){
3464 flags |= SQLITE_OPEN_URI;
3465 }else{
3466 flags &= ~SQLITE_OPEN_URI;
3468 }else{
3469 Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
3470 return TCL_ERROR;
3473 if( objc<3 || (objc&1)!=1 ){
3474 Tcl_WrongNumArgs(interp, 1, objv,
3475 "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
3476 " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
3477 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3478 " ?-key CODECKEY?"
3479 #endif
3481 return TCL_ERROR;
3483 zErrMsg = 0;
3484 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
3485 memset(p, 0, sizeof(*p));
3486 zFile = Tcl_GetStringFromObj(objv[2], 0);
3487 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
3488 rc = sqlite3_open_v2(zFile, &p->db, flags, zVfs);
3489 Tcl_DStringFree(&translatedFilename);
3490 if( p->db ){
3491 if( SQLITE_OK!=sqlite3_errcode(p->db) ){
3492 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
3493 sqlite3_close(p->db);
3494 p->db = 0;
3496 }else{
3497 zErrMsg = sqlite3_mprintf("%s", sqlite3_errstr(rc));
3499 #if defined(SQLITE_HAS_CODEC) && !defined(SQLITE_OMIT_CODEC_FROM_TCL)
3500 if( p->db ){
3501 sqlite3_key(p->db, pKey, nKey);
3503 #endif
3504 if( p->db==0 ){
3505 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
3506 Tcl_Free((char*)p);
3507 sqlite3_free(zErrMsg);
3508 return TCL_ERROR;
3510 p->maxStmt = NUM_PREPARED_STMTS;
3511 p->openFlags = flags & SQLITE_OPEN_URI;
3512 p->interp = interp;
3513 zArg = Tcl_GetStringFromObj(objv[1], 0);
3514 if( DbUseNre() ){
3515 Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
3516 (char*)p, DbDeleteCmd);
3517 }else{
3518 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
3520 return TCL_OK;
3524 ** Provide a dummy Tcl_InitStubs if we are using this as a static
3525 ** library.
3527 #ifndef USE_TCL_STUBS
3528 # undef Tcl_InitStubs
3529 # define Tcl_InitStubs(a,b,c) TCL_VERSION
3530 #endif
3533 ** Make sure we have a PACKAGE_VERSION macro defined. This will be
3534 ** defined automatically by the TEA makefile. But other makefiles
3535 ** do not define it.
3537 #ifndef PACKAGE_VERSION
3538 # define PACKAGE_VERSION SQLITE_VERSION
3539 #endif
3542 ** Initialize this module.
3544 ** This Tcl module contains only a single new Tcl command named "sqlite".
3545 ** (Hence there is no namespace. There is no point in using a namespace
3546 ** if the extension only supplies one new name!) The "sqlite" command is
3547 ** used to open a new SQLite database. See the DbMain() routine above
3548 ** for additional information.
3550 ** The EXTERN macros are required by TCL in order to work on windows.
3552 EXTERN int Sqlite3_Init(Tcl_Interp *interp){
3553 int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR;
3554 if( rc==TCL_OK ){
3555 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
3556 #ifndef SQLITE_3_SUFFIX_ONLY
3557 /* The "sqlite" alias is undocumented. It is here only to support
3558 ** legacy scripts. All new scripts should use only the "sqlite3"
3559 ** command. */
3560 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
3561 #endif
3562 rc = Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
3564 return rc;
3566 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
3567 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3568 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3570 /* Because it accesses the file-system and uses persistent state, SQLite
3571 ** is not considered appropriate for safe interpreters. Hence, we cause
3572 ** the _SafeInit() interfaces return TCL_ERROR.
3574 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; }
3575 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;}
3579 #ifndef SQLITE_3_SUFFIX_ONLY
3580 int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
3581 int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
3582 int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3583 int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3584 #endif
3587 ** If the TCLSH macro is defined, add code to make a stand-alone program.
3589 #if defined(TCLSH)
3591 /* This is the main routine for an ordinary TCL shell. If there are
3592 ** are arguments, run the first argument as a script. Otherwise,
3593 ** read TCL commands from standard input
3595 static const char *tclsh_main_loop(void){
3596 static const char zMainloop[] =
3597 "if {[llength $argv]>=1} {\n"
3598 "set argv0 [lindex $argv 0]\n"
3599 "set argv [lrange $argv 1 end]\n"
3600 "source $argv0\n"
3601 "} else {\n"
3602 "set line {}\n"
3603 "while {![eof stdin]} {\n"
3604 "if {$line!=\"\"} {\n"
3605 "puts -nonewline \"> \"\n"
3606 "} else {\n"
3607 "puts -nonewline \"% \"\n"
3608 "}\n"
3609 "flush stdout\n"
3610 "append line [gets stdin]\n"
3611 "if {[info complete $line]} {\n"
3612 "if {[catch {uplevel #0 $line} result]} {\n"
3613 "puts stderr \"Error: $result\"\n"
3614 "} elseif {$result!=\"\"} {\n"
3615 "puts $result\n"
3616 "}\n"
3617 "set line {}\n"
3618 "} else {\n"
3619 "append line \\n\n"
3620 "}\n"
3621 "}\n"
3622 "}\n"
3624 return zMainloop;
3627 #define TCLSH_MAIN main /* Needed to fake out mktclapp */
3628 int SQLITE_CDECL TCLSH_MAIN(int argc, char **argv){
3629 Tcl_Interp *interp;
3630 int i;
3631 const char *zScript = 0;
3632 char zArgc[32];
3633 #if defined(TCLSH_INIT_PROC)
3634 extern const char *TCLSH_INIT_PROC(Tcl_Interp*);
3635 #endif
3637 #if !defined(_WIN32_WCE)
3638 if( getenv("BREAK") ){
3639 fprintf(stderr,
3640 "attach debugger to process %d and press any key to continue.\n",
3641 GETPID());
3642 fgetc(stdin);
3644 #endif
3646 /* Call sqlite3_shutdown() once before doing anything else. This is to
3647 ** test that sqlite3_shutdown() can be safely called by a process before
3648 ** sqlite3_initialize() is. */
3649 sqlite3_shutdown();
3651 Tcl_FindExecutable(argv[0]);
3652 Tcl_SetSystemEncoding(NULL, "utf-8");
3653 interp = Tcl_CreateInterp();
3654 Sqlite3_Init(interp);
3656 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-1);
3657 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
3658 Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
3659 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
3660 for(i=1; i<argc; i++){
3661 Tcl_SetVar(interp, "argv", argv[i],
3662 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
3664 #if defined(TCLSH_INIT_PROC)
3665 zScript = TCLSH_INIT_PROC(interp);
3666 #endif
3667 if( zScript==0 ){
3668 zScript = tclsh_main_loop();
3670 if( Tcl_GlobalEval(interp, zScript)!=TCL_OK ){
3671 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
3672 if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
3673 fprintf(stderr,"%s: %s\n", *argv, zInfo);
3674 return 1;
3676 return 0;
3678 #endif /* TCLSH */