1 #ifdef USE_SYSTEM_SQLITE
2 # include <sqlite3.h>
3 #else
4 #include "sqlite3.c"
5 #endif
6 /*
7 ** 2001 September 15
8 **
9 ** The author disclaims copyright to this source code. In place of
10 ** a legal notice, here is a blessing:
11 **
12 ** May you do good and not evil.
13 ** May you find forgiveness for yourself and forgive others.
14 ** May you share freely, never taking more than you give.
15 **
16 *************************************************************************
17 ** A TCL Interface to SQLite. Append this file to sqlite3.c and
18 ** compile the whole thing to build a TCL-enabled version of SQLite.
19 **
20 ** Compile-time options:
21 **
22 ** -DTCLSH Add a "main()" routine that works as a tclsh.
23 **
24 ** -DTCLSH_INIT_PROC=name
25 **
26 ** Invoke name(interp) to initialize the Tcl interpreter.
27 ** If name(interp) returns a non-NULL string, then run
28 ** that string as a Tcl script to launch the application.
29 ** If name(interp) returns NULL, then run the regular
30 ** tclsh-emulator code.
31 */
32 #ifdef TCLSH_INIT_PROC
33 # define TCLSH 1
34 #endif
35
36 /*
37 ** If requested, include the SQLite compiler options file for MSVC.
38 */
39 #if defined(INCLUDE_MSVC_H)
40 # include "msvc.h"
41 #endif
42
43 #if defined(INCLUDE_SQLITE_TCL_H)
44 # include "sqlite_tcl.h"
45 #else
46 # include "tcl.h"
47 # ifndef SQLITE_TCLAPI
48 # define SQLITE_TCLAPI
49 # endif
50 #endif
51 #include <errno.h>
52
53 /*
54 ** Some additional include files are needed if this file is not
55 ** appended to the amalgamation.
56 */
57 #ifndef SQLITE_AMALGAMATION
58 # include "sqlite3.h"
59 # include <stdlib.h>
60 # include <string.h>
61 # include <assert.h>
62 typedef unsigned char u8;
63 #endif
64 #include <ctype.h>
65
66 /* Used to get the current process ID */
67 #if !defined(_WIN32)
68 # include <signal.h>
69 # include <unistd.h>
70 # define GETPID getpid
71 #elif !defined(_WIN32_WCE)
72 # ifndef SQLITE_AMALGAMATION
73 # ifndef WIN32_LEAN_AND_MEAN
74 # define WIN32_LEAN_AND_MEAN
75 # endif
76 # include <windows.h>
77 # endif
78 # include <io.h>
79 # define isatty(h) _isatty(h)
80 # define GETPID (int)GetCurrentProcessId
81 #endif
82
83 /*
84 * Windows needs to know which symbols to export. Unix does not.
85 * BUILD_sqlite should be undefined for Unix.
86 */
87 #ifdef BUILD_sqlite
88 #undef TCL_STORAGE_CLASS
89 #define TCL_STORAGE_CLASS DLLEXPORT
90 #endif /* BUILD_sqlite */
91
92 #define NUM_PREPARED_STMTS 10
93 #define MAX_PREPARED_STMTS 100
94
95 /* Forward declaration */
96 typedef struct SqliteDb SqliteDb;
97
98 /*
99 ** New SQL functions can be created as TCL scripts. Each such function
100 ** is described by an instance of the following structure.
101 **
102 ** Variable eType may be set to SQLITE_INTEGER, SQLITE_FLOAT, SQLITE_TEXT,
103 ** SQLITE_BLOB or SQLITE_NULL. If it is SQLITE_NULL, then the implementation
104 ** attempts to determine the type of the result based on the Tcl object.
105 ** If it is SQLITE_TEXT or SQLITE_BLOB, then a text (sqlite3_result_text())
106 ** or blob (sqlite3_result_blob()) is returned. If it is SQLITE_INTEGER
107 ** or SQLITE_FLOAT, then an attempt is made to return an integer or float
108 ** value, falling back to float and then text if this is not possible.
109 */
110 typedef struct SqlFunc SqlFunc;
111 struct SqlFunc {
112 Tcl_Interp *interp; /* The TCL interpret to execute the function */
113 Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */
114 SqliteDb *pDb; /* Database connection that owns this function */
115 int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */
116 int eType; /* Type of value to return */
117 char *zName; /* Name of this function */
118 SqlFunc *pNext; /* Next function on the list of them all */
119 };
120
121 /*
122 ** New collation sequences function can be created as TCL scripts. Each such
123 ** function is described by an instance of the following structure.
124 */
125 typedef struct SqlCollate SqlCollate;
126 struct SqlCollate {
127 Tcl_Interp *interp; /* The TCL interpret to execute the function */
128 char *zScript; /* The script to be run */
129 SqlCollate *pNext; /* Next function on the list of them all */
130 };
131
132 /*
133 ** Prepared statements are cached for faster execution. Each prepared
134 ** statement is described by an instance of the following structure.
135 */
136 typedef struct SqlPreparedStmt SqlPreparedStmt;
137 struct SqlPreparedStmt {
138 SqlPreparedStmt *pNext; /* Next in linked list */
139 SqlPreparedStmt *pPrev; /* Previous on the list */
140 sqlite3_stmt *pStmt; /* The prepared statement */
141 int nSql; /* chars in zSql[] */
142 const char *zSql; /* Text of the SQL statement */
143 int nParm; /* Size of apParm array */
144 Tcl_Obj **apParm; /* Array of referenced object pointers */
145 };
146
147 typedef struct IncrblobChannel IncrblobChannel;
148
149 /*
150 ** There is one instance of this structure for each SQLite database
151 ** that has been opened by the SQLite TCL interface.
152 **
153 ** If this module is built with SQLITE_TEST defined (to create the SQLite
154 ** testfixture executable), then it may be configured to use either
155 ** sqlite3_prepare_v2() or sqlite3_prepare() to prepare SQL statements.
156 ** If SqliteDb.bLegacyPrepare is true, sqlite3_prepare() is used.
157 */
158 struct SqliteDb {
159 sqlite3 *db; /* The "real" database structure. MUST BE FIRST */
160 Tcl_Interp *interp; /* The interpreter used for this database */
161 char *zBusy; /* The busy callback routine */
162 char *zCommit; /* The commit hook callback routine */
163 char *zTrace; /* The trace callback routine */
164 char *zTraceV2; /* The trace_v2 callback routine */
165 char *zProfile; /* The profile callback routine */
166 char *zProgress; /* The progress callback routine */
167 char *zBindFallback; /* Callback to invoke on a binding miss */
168 char *zAuth; /* The authorization callback routine */
169 int disableAuth; /* Disable the authorizer if it exists */
170 char *zNull; /* Text to substitute for an SQL NULL value */
171 SqlFunc *pFunc; /* List of SQL functions */
172 Tcl_Obj *pUpdateHook; /* Update hook script (if any) */
173 Tcl_Obj *pPreUpdateHook; /* Pre-update hook script (if any) */
174 Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */
175 Tcl_Obj *pWalHook; /* WAL hook script (if any) */
176 Tcl_Obj *pUnlockNotify; /* Unlock notify script (if any) */
177 SqlCollate *pCollate; /* List of SQL collation functions */
178 int rc; /* Return code of most recent sqlite3_exec() */
179 Tcl_Obj *pCollateNeeded; /* Collation needed script */
180 SqlPreparedStmt *stmtList; /* List of prepared statements*/
181 SqlPreparedStmt *stmtLast; /* Last statement in the list */
182 int maxStmt; /* The next maximum number of stmtList */
183 int nStmt; /* Number of statements in stmtList */
184 IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
185 int nStep, nSort, nIndex; /* Statistics for most recent operation */
186 int nVMStep; /* Another statistic for most recent operation */
187 int nTransaction; /* Number of nested [transaction] methods */
188 int openFlags; /* Flags used to open. (SQLITE_OPEN_URI) */
189 #ifdef SQLITE_TEST
190 int bLegacyPrepare; /* True to use sqlite3_prepare() */
191 #endif
192 };
193
194 struct IncrblobChannel {
195 sqlite3_blob *pBlob; /* sqlite3 blob handle */
196 SqliteDb *pDb; /* Associated database connection */
197 int iSeek; /* Current seek offset */
198 Tcl_Channel channel; /* Channel identifier */
199 IncrblobChannel *pNext; /* Linked list of all open incrblob channels */
200 IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */
201 };
202
203 /*
204 ** Compute a string length that is limited to what can be stored in
205 ** lower 30 bits of a 32-bit signed integer.
206 */
strlen30(const char * z)207 static int strlen30(const char *z){
208 const char *z2 = z;
209 while( *z2 ){ z2++; }
210 return 0x3fffffff & (int)(z2 - z);
211 }
212
213
214 #ifndef SQLITE_OMIT_INCRBLOB
215 /*
216 ** Close all incrblob channels opened using database connection pDb.
217 ** This is called when shutting down the database connection.
218 */
closeIncrblobChannels(SqliteDb * pDb)219 static void closeIncrblobChannels(SqliteDb *pDb){
220 IncrblobChannel *p;
221 IncrblobChannel *pNext;
222
223 for(p=pDb->pIncrblob; p; p=pNext){
224 pNext = p->pNext;
225
226 /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
227 ** which deletes the IncrblobChannel structure at *p. So do not
228 ** call Tcl_Free() here.
229 */
230 Tcl_UnregisterChannel(pDb->interp, p->channel);
231 }
232 }
233
234 /*
235 ** Close an incremental blob channel.
236 */
incrblobClose(ClientData instanceData,Tcl_Interp * interp)237 static int SQLITE_TCLAPI incrblobClose(
238 ClientData instanceData,
239 Tcl_Interp *interp
240 ){
241 IncrblobChannel *p = (IncrblobChannel *)instanceData;
242 int rc = sqlite3_blob_close(p->pBlob);
243 sqlite3 *db = p->pDb->db;
244
245 /* Remove the channel from the SqliteDb.pIncrblob list. */
246 if( p->pNext ){
247 p->pNext->pPrev = p->pPrev;
248 }
249 if( p->pPrev ){
250 p->pPrev->pNext = p->pNext;
251 }
252 if( p->pDb->pIncrblob==p ){
253 p->pDb->pIncrblob = p->pNext;
254 }
255
256 /* Free the IncrblobChannel structure */
257 Tcl_Free((char *)p);
258
259 if( rc!=SQLITE_OK ){
260 Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
261 return TCL_ERROR;
262 }
263 return TCL_OK;
264 }
265
266 /*
267 ** Read data from an incremental blob channel.
268 */
incrblobInput(ClientData instanceData,char * buf,int bufSize,int * errorCodePtr)269 static int SQLITE_TCLAPI incrblobInput(
270 ClientData instanceData,
271 char *buf,
272 int bufSize,
273 int *errorCodePtr
274 ){
275 IncrblobChannel *p = (IncrblobChannel *)instanceData;
276 int nRead = bufSize; /* Number of bytes to read */
277 int nBlob; /* Total size of the blob */
278 int rc; /* sqlite error code */
279
280 nBlob = sqlite3_blob_bytes(p->pBlob);
281 if( (p->iSeek+nRead)>nBlob ){
282 nRead = nBlob-p->iSeek;
283 }
284 if( nRead<=0 ){
285 return 0;
286 }
287
288 rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
289 if( rc!=SQLITE_OK ){
290 *errorCodePtr = rc;
291 return -1;
292 }
293
294 p->iSeek += nRead;
295 return nRead;
296 }
297
298 /*
299 ** Write data to an incremental blob channel.
300 */
incrblobOutput(ClientData instanceData,CONST char * buf,int toWrite,int * errorCodePtr)301 static int SQLITE_TCLAPI incrblobOutput(
302 ClientData instanceData,
303 CONST char *buf,
304 int toWrite,
305 int *errorCodePtr
306 ){
307 IncrblobChannel *p = (IncrblobChannel *)instanceData;
308 int nWrite = toWrite; /* Number of bytes to write */
309 int nBlob; /* Total size of the blob */
310 int rc; /* sqlite error code */
311
312 nBlob = sqlite3_blob_bytes(p->pBlob);
313 if( (p->iSeek+nWrite)>nBlob ){
314 *errorCodePtr = EINVAL;
315 return -1;
316 }
317 if( nWrite<=0 ){
318 return 0;
319 }
320
321 rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
322 if( rc!=SQLITE_OK ){
323 *errorCodePtr = EIO;
324 return -1;
325 }
326
327 p->iSeek += nWrite;
328 return nWrite;
329 }
330
331 /*
332 ** Seek an incremental blob channel.
333 */
incrblobSeek(ClientData instanceData,long offset,int seekMode,int * errorCodePtr)334 static int SQLITE_TCLAPI incrblobSeek(
335 ClientData instanceData,
336 long offset,
337 int seekMode,
338 int *errorCodePtr
339 ){
340 IncrblobChannel *p = (IncrblobChannel *)instanceData;
341
342 switch( seekMode ){
343 case SEEK_SET:
344 p->iSeek = offset;
345 break;
346 case SEEK_CUR:
347 p->iSeek += offset;
348 break;
349 case SEEK_END:
350 p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
351 break;
352
353 default: assert(!"Bad seekMode");
354 }
355
356 return p->iSeek;
357 }
358
359
incrblobWatch(ClientData instanceData,int mode)360 static void SQLITE_TCLAPI incrblobWatch(
361 ClientData instanceData,
362 int mode
363 ){
364 /* NO-OP */
365 }
incrblobHandle(ClientData instanceData,int dir,ClientData * hPtr)366 static int SQLITE_TCLAPI incrblobHandle(
367 ClientData instanceData,
368 int dir,
369 ClientData *hPtr
370 ){
371 return TCL_ERROR;
372 }
373
374 static Tcl_ChannelType IncrblobChannelType = {
375 "incrblob", /* typeName */
376 TCL_CHANNEL_VERSION_2, /* version */
377 incrblobClose, /* closeProc */
378 incrblobInput, /* inputProc */
379 incrblobOutput, /* outputProc */
380 incrblobSeek, /* seekProc */
381 0, /* setOptionProc */
382 0, /* getOptionProc */
383 incrblobWatch, /* watchProc (this is a no-op) */
384 incrblobHandle, /* getHandleProc (always returns error) */
385 0, /* close2Proc */
386 0, /* blockModeProc */
387 0, /* flushProc */
388 0, /* handlerProc */
389 0, /* wideSeekProc */
390 };
391
392 /*
393 ** Create a new incrblob channel.
394 */
createIncrblobChannel(Tcl_Interp * interp,SqliteDb * pDb,const char * zDb,const char * zTable,const char * zColumn,sqlite_int64 iRow,int isReadonly)395 static int createIncrblobChannel(
396 Tcl_Interp *interp,
397 SqliteDb *pDb,
398 const char *zDb,
399 const char *zTable,
400 const char *zColumn,
401 sqlite_int64 iRow,
402 int isReadonly
403 ){
404 IncrblobChannel *p;
405 sqlite3 *db = pDb->db;
406 sqlite3_blob *pBlob;
407 int rc;
408 int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
409
410 /* This variable is used to name the channels: "incrblob_[incr count]" */
411 static int count = 0;
412 char zChannel[64];
413
414 rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
415 if( rc!=SQLITE_OK ){
416 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
417 return TCL_ERROR;
418 }
419
420 p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
421 p->iSeek = 0;
422 p->pBlob = pBlob;
423
424 sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
425 p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
426 Tcl_RegisterChannel(interp, p->channel);
427
428 /* Link the new channel into the SqliteDb.pIncrblob list. */
429 p->pNext = pDb->pIncrblob;
430 p->pPrev = 0;
431 if( p->pNext ){
432 p->pNext->pPrev = p;
433 }
434 pDb->pIncrblob = p;
435 p->pDb = pDb;
436
437 Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
438 return TCL_OK;
439 }
440 #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
441 #define closeIncrblobChannels(pDb)
442 #endif
443
444 /*
445 ** Look at the script prefix in pCmd. We will be executing this script
446 ** after first appending one or more arguments. This routine analyzes
447 ** the script to see if it is safe to use Tcl_EvalObjv() on the script
448 ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much
449 ** faster.
450 **
451 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
452 ** command name followed by zero or more arguments with no [...] or $
453 ** or {...} or ; to be seen anywhere. Most callback scripts consist
454 ** of just a single procedure name and they meet this requirement.
455 */
safeToUseEvalObjv(Tcl_Interp * interp,Tcl_Obj * pCmd)456 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
457 /* We could try to do something with Tcl_Parse(). But we will instead
458 ** just do a search for forbidden characters. If any of the forbidden
459 ** characters appear in pCmd, we will report the string as unsafe.
460 */
461 const char *z;
462 int n;
463 z = Tcl_GetStringFromObj(pCmd, &n);
464 while( n-- > 0 ){
465 int c = *(z++);
466 if( c=='$' || c=='[' || c==';' ) return 0;
467 }
468 return 1;
469 }
470
471 /*
472 ** Find an SqlFunc structure with the given name. Or create a new
473 ** one if an existing one cannot be found. Return a pointer to the
474 ** structure.
475 */
findSqlFunc(SqliteDb * pDb,const char * zName)476 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
477 SqlFunc *p, *pNew;
478 int nName = strlen30(zName);
479 pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );
480 pNew->zName = (char*)&pNew[1];
481 memcpy(pNew->zName, zName, nName+1);
482 for(p=pDb->pFunc; p; p=p->pNext){
483 if( sqlite3_stricmp(p->zName, pNew->zName)==0 ){
484 Tcl_Free((char*)pNew);
485 return p;
486 }
487 }
488 pNew->interp = pDb->interp;
489 pNew->pDb = pDb;
490 pNew->pScript = 0;
491 pNew->pNext = pDb->pFunc;
492 pDb->pFunc = pNew;
493 return pNew;
494 }
495
496 /*
497 ** Free a single SqlPreparedStmt object.
498 */
dbFreeStmt(SqlPreparedStmt * pStmt)499 static void dbFreeStmt(SqlPreparedStmt *pStmt){
500 #ifdef SQLITE_TEST
501 if( sqlite3_sql(pStmt->pStmt)==0 ){
502 Tcl_Free((char *)pStmt->zSql);
503 }
504 #endif
505 sqlite3_finalize(pStmt->pStmt);
506 Tcl_Free((char *)pStmt);
507 }
508
509 /*
510 ** Finalize and free a list of prepared statements
511 */
flushStmtCache(SqliteDb * pDb)512 static void flushStmtCache(SqliteDb *pDb){
513 SqlPreparedStmt *pPreStmt;
514 SqlPreparedStmt *pNext;
515
516 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pNext){
517 pNext = pPreStmt->pNext;
518 dbFreeStmt(pPreStmt);
519 }
520 pDb->nStmt = 0;
521 pDb->stmtLast = 0;
522 pDb->stmtList = 0;
523 }
524
525 /*
526 ** TCL calls this procedure when an sqlite3 database command is
527 ** deleted.
528 */
DbDeleteCmd(void * db)529 static void SQLITE_TCLAPI DbDeleteCmd(void *db){
530 SqliteDb *pDb = (SqliteDb*)db;
531 flushStmtCache(pDb);
532 closeIncrblobChannels(pDb);
533 sqlite3_close(pDb->db);
534 while( pDb->pFunc ){
535 SqlFunc *pFunc = pDb->pFunc;
536 pDb->pFunc = pFunc->pNext;
537 assert( pFunc->pDb==pDb );
538 Tcl_DecrRefCount(pFunc->pScript);
539 Tcl_Free((char*)pFunc);
540 }
541 while( pDb->pCollate ){
542 SqlCollate *pCollate = pDb->pCollate;
543 pDb->pCollate = pCollate->pNext;
544 Tcl_Free((char*)pCollate);
545 }
546 if( pDb->zBusy ){
547 Tcl_Free(pDb->zBusy);
548 }
549 if( pDb->zTrace ){
550 Tcl_Free(pDb->zTrace);
551 }
552 if( pDb->zTraceV2 ){
553 Tcl_Free(pDb->zTraceV2);
554 }
555 if( pDb->zProfile ){
556 Tcl_Free(pDb->zProfile);
557 }
558 if( pDb->zBindFallback ){
559 Tcl_Free(pDb->zBindFallback);
560 }
561 if( pDb->zAuth ){
562 Tcl_Free(pDb->zAuth);
563 }
564 if( pDb->zNull ){
565 Tcl_Free(pDb->zNull);
566 }
567 if( pDb->pUpdateHook ){
568 Tcl_DecrRefCount(pDb->pUpdateHook);
569 }
570 if( pDb->pPreUpdateHook ){
571 Tcl_DecrRefCount(pDb->pPreUpdateHook);
572 }
573 if( pDb->pRollbackHook ){
574 Tcl_DecrRefCount(pDb->pRollbackHook);
575 }
576 if( pDb->pWalHook ){
577 Tcl_DecrRefCount(pDb->pWalHook);
578 }
579 if( pDb->pCollateNeeded ){
580 Tcl_DecrRefCount(pDb->pCollateNeeded);
581 }
582 Tcl_Free((char*)pDb);
583 }
584
585 /*
586 ** This routine is called when a database file is locked while trying
587 ** to execute SQL.
588 */
DbBusyHandler(void * cd,int nTries)589 static int DbBusyHandler(void *cd, int nTries){
590 SqliteDb *pDb = (SqliteDb*)cd;
591 int rc;
592 char zVal[30];
593
594 sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
595 rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
596 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
597 return 0;
598 }
599 return 1;
600 }
601
602 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
603 /*
604 ** This routine is invoked as the 'progress callback' for the database.
605 */
DbProgressHandler(void * cd)606 static int DbProgressHandler(void *cd){
607 SqliteDb *pDb = (SqliteDb*)cd;
608 int rc;
609
610 assert( pDb->zProgress );
611 rc = Tcl_Eval(pDb->interp, pDb->zProgress);
612 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
613 return 1;
614 }
615 return 0;
616 }
617 #endif
618
619 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
620 !defined(SQLITE_OMIT_DEPRECATED)
621 /*
622 ** This routine is called by the SQLite trace handler whenever a new
623 ** block of SQL is executed. The TCL script in pDb->zTrace is executed.
624 */
DbTraceHandler(void * cd,const char * zSql)625 static void DbTraceHandler(void *cd, const char *zSql){
626 SqliteDb *pDb = (SqliteDb*)cd;
627 Tcl_DString str;
628
629 Tcl_DStringInit(&str);
630 Tcl_DStringAppend(&str, pDb->zTrace, -1);
631 Tcl_DStringAppendElement(&str, zSql);
632 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
633 Tcl_DStringFree(&str);
634 Tcl_ResetResult(pDb->interp);
635 }
636 #endif
637
638 #ifndef SQLITE_OMIT_TRACE
639 /*
640 ** This routine is called by the SQLite trace_v2 handler whenever a new
641 ** supported event is generated. Unsupported event types are ignored.
642 ** The TCL script in pDb->zTraceV2 is executed, with the arguments for
643 ** the event appended to it (as list elements).
644 */
DbTraceV2Handler(unsigned type,void * cd,void * pd,void * xd)645 static int DbTraceV2Handler(
646 unsigned type, /* One of the SQLITE_TRACE_* event types. */
647 void *cd, /* The original context data pointer. */
648 void *pd, /* Primary event data, depends on event type. */
649 void *xd /* Extra event data, depends on event type. */
650 ){
651 SqliteDb *pDb = (SqliteDb*)cd;
652 Tcl_Obj *pCmd;
653
654 switch( type ){
655 case SQLITE_TRACE_STMT: {
656 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
657 char *zSql = (char *)xd;
658
659 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
660 Tcl_IncrRefCount(pCmd);
661 Tcl_ListObjAppendElement(pDb->interp, pCmd,
662 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
663 Tcl_ListObjAppendElement(pDb->interp, pCmd,
664 Tcl_NewStringObj(zSql, -1));
665 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
666 Tcl_DecrRefCount(pCmd);
667 Tcl_ResetResult(pDb->interp);
668 break;
669 }
670 case SQLITE_TRACE_PROFILE: {
671 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
672 sqlite3_int64 ns = *(sqlite3_int64*)xd;
673
674 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
675 Tcl_IncrRefCount(pCmd);
676 Tcl_ListObjAppendElement(pDb->interp, pCmd,
677 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
678 Tcl_ListObjAppendElement(pDb->interp, pCmd,
679 Tcl_NewWideIntObj((Tcl_WideInt)ns));
680 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
681 Tcl_DecrRefCount(pCmd);
682 Tcl_ResetResult(pDb->interp);
683 break;
684 }
685 case SQLITE_TRACE_ROW: {
686 sqlite3_stmt *pStmt = (sqlite3_stmt *)pd;
687
688 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
689 Tcl_IncrRefCount(pCmd);
690 Tcl_ListObjAppendElement(pDb->interp, pCmd,
691 Tcl_NewWideIntObj((Tcl_WideInt)pStmt));
692 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
693 Tcl_DecrRefCount(pCmd);
694 Tcl_ResetResult(pDb->interp);
695 break;
696 }
697 case SQLITE_TRACE_CLOSE: {
698 sqlite3 *db = (sqlite3 *)pd;
699
700 pCmd = Tcl_NewStringObj(pDb->zTraceV2, -1);
701 Tcl_IncrRefCount(pCmd);
702 Tcl_ListObjAppendElement(pDb->interp, pCmd,
703 Tcl_NewWideIntObj((Tcl_WideInt)db));
704 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
705 Tcl_DecrRefCount(pCmd);
706 Tcl_ResetResult(pDb->interp);
707 break;
708 }
709 }
710 return SQLITE_OK;
711 }
712 #endif
713
714 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
715 !defined(SQLITE_OMIT_DEPRECATED)
716 /*
717 ** This routine is called by the SQLite profile handler after a statement
718 ** SQL has executed. The TCL script in pDb->zProfile is evaluated.
719 */
DbProfileHandler(void * cd,const char * zSql,sqlite_uint64 tm)720 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
721 SqliteDb *pDb = (SqliteDb*)cd;
722 Tcl_DString str;
723 char zTm[100];
724
725 sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
726 Tcl_DStringInit(&str);
727 Tcl_DStringAppend(&str, pDb->zProfile, -1);
728 Tcl_DStringAppendElement(&str, zSql);
729 Tcl_DStringAppendElement(&str, zTm);
730 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
731 Tcl_DStringFree(&str);
732 Tcl_ResetResult(pDb->interp);
733 }
734 #endif
735
736 /*
737 ** This routine is called when a transaction is committed. The
738 ** TCL script in pDb->zCommit is executed. If it returns non-zero or
739 ** if it throws an exception, the transaction is rolled back instead
740 ** of being committed.
741 */
DbCommitHandler(void * cd)742 static int DbCommitHandler(void *cd){
743 SqliteDb *pDb = (SqliteDb*)cd;
744 int rc;
745
746 rc = Tcl_Eval(pDb->interp, pDb->zCommit);
747 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
748 return 1;
749 }
750 return 0;
751 }
752
DbRollbackHandler(void * clientData)753 static void DbRollbackHandler(void *clientData){
754 SqliteDb *pDb = (SqliteDb*)clientData;
755 assert(pDb->pRollbackHook);
756 if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
757 Tcl_BackgroundError(pDb->interp);
758 }
759 }
760
761 /*
762 ** This procedure handles wal_hook callbacks.
763 */
DbWalHandler(void * clientData,sqlite3 * db,const char * zDb,int nEntry)764 static int DbWalHandler(
765 void *clientData,
766 sqlite3 *db,
767 const char *zDb,
768 int nEntry
769 ){
770 int ret = SQLITE_OK;
771 Tcl_Obj *p;
772 SqliteDb *pDb = (SqliteDb*)clientData;
773 Tcl_Interp *interp = pDb->interp;
774 assert(pDb->pWalHook);
775
776 assert( db==pDb->db );
777 p = Tcl_DuplicateObj(pDb->pWalHook);
778 Tcl_IncrRefCount(p);
779 Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));
780 Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));
781 if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)
782 || TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)
783 ){
784 Tcl_BackgroundError(interp);
785 }
786 Tcl_DecrRefCount(p);
787
788 return ret;
789 }
790
791 #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
setTestUnlockNotifyVars(Tcl_Interp * interp,int iArg,int nArg)792 static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){
793 char zBuf[64];
794 sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", iArg);
795 Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);
796 sqlite3_snprintf(sizeof(zBuf), zBuf, "%d", nArg);
797 Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);
798 }
799 #else
800 # define setTestUnlockNotifyVars(x,y,z)
801 #endif
802
803 #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
DbUnlockNotify(void ** apArg,int nArg)804 static void DbUnlockNotify(void **apArg, int nArg){
805 int i;
806 for(i=0; i<nArg; i++){
807 const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
808 SqliteDb *pDb = (SqliteDb *)apArg[i];
809 setTestUnlockNotifyVars(pDb->interp, i, nArg);
810 assert( pDb->pUnlockNotify);
811 Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
812 Tcl_DecrRefCount(pDb->pUnlockNotify);
813 pDb->pUnlockNotify = 0;
814 }
815 }
816 #endif
817
818 #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
819 /*
820 ** Pre-update hook callback.
821 */
DbPreUpdateHandler(void * p,sqlite3 * db,int op,const char * zDb,const char * zTbl,sqlite_int64 iKey1,sqlite_int64 iKey2)822 static void DbPreUpdateHandler(
823 void *p,
824 sqlite3 *db,
825 int op,
826 const char *zDb,
827 const char *zTbl,
828 sqlite_int64 iKey1,
829 sqlite_int64 iKey2
830 ){
831 SqliteDb *pDb = (SqliteDb *)p;
832 Tcl_Obj *pCmd;
833 static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
834
835 assert( (SQLITE_DELETE-1)/9 == 0 );
836 assert( (SQLITE_INSERT-1)/9 == 1 );
837 assert( (SQLITE_UPDATE-1)/9 == 2 );
838 assert( pDb->pPreUpdateHook );
839 assert( db==pDb->db );
840 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
841
842 pCmd = Tcl_DuplicateObj(pDb->pPreUpdateHook);
843 Tcl_IncrRefCount(pCmd);
844 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
845 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
846 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
847 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey1));
848 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(iKey2));
849 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
850 Tcl_DecrRefCount(pCmd);
851 }
852 #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
853
DbUpdateHandler(void * p,int op,const char * zDb,const char * zTbl,sqlite_int64 rowid)854 static void DbUpdateHandler(
855 void *p,
856 int op,
857 const char *zDb,
858 const char *zTbl,
859 sqlite_int64 rowid
860 ){
861 SqliteDb *pDb = (SqliteDb *)p;
862 Tcl_Obj *pCmd;
863 static const char *azStr[] = {"DELETE", "INSERT", "UPDATE"};
864
865 assert( (SQLITE_DELETE-1)/9 == 0 );
866 assert( (SQLITE_INSERT-1)/9 == 1 );
867 assert( (SQLITE_UPDATE-1)/9 == 2 );
868
869 assert( pDb->pUpdateHook );
870 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
871
872 pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
873 Tcl_IncrRefCount(pCmd);
874 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(azStr[(op-1)/9], -1));
875 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
876 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
877 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
878 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
879 Tcl_DecrRefCount(pCmd);
880 }
881
tclCollateNeeded(void * pCtx,sqlite3 * db,int enc,const char * zName)882 static void tclCollateNeeded(
883 void *pCtx,
884 sqlite3 *db,
885 int enc,
886 const char *zName
887 ){
888 SqliteDb *pDb = (SqliteDb *)pCtx;
889 Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
890 Tcl_IncrRefCount(pScript);
891 Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
892 Tcl_EvalObjEx(pDb->interp, pScript, 0);
893 Tcl_DecrRefCount(pScript);
894 }
895
896 /*
897 ** This routine is called to evaluate an SQL collation function implemented
898 ** using TCL script.
899 */
tclSqlCollate(void * pCtx,int nA,const void * zA,int nB,const void * zB)900 static int tclSqlCollate(
901 void *pCtx,
902 int nA,
903 const void *zA,
904 int nB,
905 const void *zB
906 ){
907 SqlCollate *p = (SqlCollate *)pCtx;
908 Tcl_Obj *pCmd;
909
910 pCmd = Tcl_NewStringObj(p->zScript, -1);
911 Tcl_IncrRefCount(pCmd);
912 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
913 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
914 Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
915 Tcl_DecrRefCount(pCmd);
916 return (atoi(Tcl_GetStringResult(p->interp)));
917 }
918
919 /*
920 ** This routine is called to evaluate an SQL function implemented
921 ** using TCL script.
922 */
tclSqlFunc(sqlite3_context * context,int argc,sqlite3_value ** argv)923 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
924 SqlFunc *p = sqlite3_user_data(context);
925 Tcl_Obj *pCmd;
926 int i;
927 int rc;
928
929 if( argc==0 ){
930 /* If there are no arguments to the function, call Tcl_EvalObjEx on the
931 ** script object directly. This allows the TCL compiler to generate
932 ** bytecode for the command on the first invocation and thus make
933 ** subsequent invocations much faster. */
934 pCmd = p->pScript;
935 Tcl_IncrRefCount(pCmd);
936 rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
937 Tcl_DecrRefCount(pCmd);
938 }else{
939 /* If there are arguments to the function, make a shallow copy of the
940 ** script object, lappend the arguments, then evaluate the copy.
941 **
942 ** By "shallow" copy, we mean only the outer list Tcl_Obj is duplicated.
943 ** The new Tcl_Obj contains pointers to the original list elements.
944 ** That way, when Tcl_EvalObjv() is run and shimmers the first element
945 ** of the list to tclCmdNameType, that alternate representation will
946 ** be preserved and reused on the next invocation.
947 */
948 Tcl_Obj **aArg;
949 int nArg;
950 if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
951 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
952 return;
953 }
954 pCmd = Tcl_NewListObj(nArg, aArg);
955 Tcl_IncrRefCount(pCmd);
956 for(i=0; i<argc; i++){
957 sqlite3_value *pIn = argv[i];
958 Tcl_Obj *pVal;
959
960 /* Set pVal to contain the i'th column of this row. */
961 switch( sqlite3_value_type(pIn) ){
962 case SQLITE_BLOB: {
963 int bytes = sqlite3_value_bytes(pIn);
964 pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
965 break;
966 }
967 case SQLITE_INTEGER: {
968 sqlite_int64 v = sqlite3_value_int64(pIn);
969 if( v>=-2147483647 && v<=2147483647 ){
970 pVal = Tcl_NewIntObj((int)v);
971 }else{
972 pVal = Tcl_NewWideIntObj(v);
973 }
974 break;
975 }
976 case SQLITE_FLOAT: {
977 double r = sqlite3_value_double(pIn);
978 pVal = Tcl_NewDoubleObj(r);
979 break;
980 }
981 case SQLITE_NULL: {
982 pVal = Tcl_NewStringObj(p->pDb->zNull, -1);
983 break;
984 }
985 default: {
986 int bytes = sqlite3_value_bytes(pIn);
987 pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
988 break;
989 }
990 }
991 rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
992 if( rc ){
993 Tcl_DecrRefCount(pCmd);
994 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
995 return;
996 }
997 }
998 if( !p->useEvalObjv ){
999 /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
1000 ** is a list without a string representation. To prevent this from
1001 ** happening, make sure pCmd has a valid string representation */
1002 Tcl_GetString(pCmd);
1003 }
1004 rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
1005 Tcl_DecrRefCount(pCmd);
1006 }
1007
1008 if( rc && rc!=TCL_RETURN ){
1009 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
1010 }else{
1011 Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
1012 int n;
1013 u8 *data;
1014 const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
1015 char c = zType[0];
1016 int eType = p->eType;
1017
1018 if( eType==SQLITE_NULL ){
1019 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
1020 /* Only return a BLOB type if the Tcl variable is a bytearray and
1021 ** has no string representation. */
1022 eType = SQLITE_BLOB;
1023 }else if( (c=='b' && strcmp(zType,"boolean")==0)
1024 || (c=='w' && strcmp(zType,"wideInt")==0)
1025 || (c=='i' && strcmp(zType,"int")==0)
1026 ){
1027 eType = SQLITE_INTEGER;
1028 }else if( c=='d' && strcmp(zType,"double")==0 ){
1029 eType = SQLITE_FLOAT;
1030 }else{
1031 eType = SQLITE_TEXT;
1032 }
1033 }
1034
1035 switch( eType ){
1036 case SQLITE_BLOB: {
1037 data = Tcl_GetByteArrayFromObj(pVar, &n);
1038 sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
1039 break;
1040 }
1041 case SQLITE_INTEGER: {
1042 Tcl_WideInt v;
1043 if( TCL_OK==Tcl_GetWideIntFromObj(0, pVar, &v) ){
1044 sqlite3_result_int64(context, v);
1045 break;
1046 }
1047 /* fall-through */
1048 }
1049 case SQLITE_FLOAT: {
1050 double r;
1051 if( TCL_OK==Tcl_GetDoubleFromObj(0, pVar, &r) ){
1052 sqlite3_result_double(context, r);
1053 break;
1054 }
1055 /* fall-through */
1056 }
1057 default: {
1058 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
1059 sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
1060 break;
1061 }
1062 }
1063
1064 }
1065 }
1066
1067 #ifndef SQLITE_OMIT_AUTHORIZATION
1068 /*
1069 ** This is the authentication function. It appends the authentication
1070 ** type code and the two arguments to zCmd[] then invokes the result
1071 ** on the interpreter. The reply is examined to determine if the
1072 ** authentication fails or succeeds.
1073 */
auth_callback(void * pArg,int code,const char * zArg1,const char * zArg2,const char * zArg3,const char * zArg4,const char * zArg5)1074 static int auth_callback(
1075 void *pArg,
1076 int code,
1077 const char *zArg1,
1078 const char *zArg2,
1079 const char *zArg3,
1080 const char *zArg4
1081 #ifdef SQLITE_USER_AUTHENTICATION
1082 ,const char *zArg5
1083 #endif
1084 ){
1085 const char *zCode;
1086 Tcl_DString str;
1087 int rc;
1088 const char *zReply;
1089 /* EVIDENCE-OF: R-38590-62769 The first parameter to the authorizer
1090 ** callback is a copy of the third parameter to the
1091 ** sqlite3_set_authorizer() interface.
1092 */
1093 SqliteDb *pDb = (SqliteDb*)pArg;
1094 if( pDb->disableAuth ) return SQLITE_OK;
1095
1096 /* EVIDENCE-OF: R-56518-44310 The second parameter to the callback is an
1097 ** integer action code that specifies the particular action to be
1098 ** authorized. */
1099 switch( code ){
1100 case SQLITE_COPY : zCode="SQLITE_COPY"; break;
1101 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
1102 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
1103 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
1104 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
1105 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
1106 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
1107 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
1108 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
1109 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
1110 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
1111 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
1112 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
1113 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
1114 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
1115 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
1116 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
1117 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
1118 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
1119 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
1120 case SQLITE_READ : zCode="SQLITE_READ"; break;
1121 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
1122 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
1123 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
1124 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
1125 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
1126 case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;
1127 case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;
1128 case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;
1129 case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;
1130 case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;
1131 case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;
1132 case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break;
1133 case SQLITE_RECURSIVE : zCode="SQLITE_RECURSIVE"; break;
1134 default : zCode="????"; break;
1135 }
1136 Tcl_DStringInit(&str);
1137 Tcl_DStringAppend(&str, pDb->zAuth, -1);
1138 Tcl_DStringAppendElement(&str, zCode);
1139 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
1140 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
1141 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
1142 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
1143 #ifdef SQLITE_USER_AUTHENTICATION
1144 Tcl_DStringAppendElement(&str, zArg5 ? zArg5 : "");
1145 #endif
1146 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
1147 Tcl_DStringFree(&str);
1148 zReply = rc==TCL_OK ? Tcl_GetStringResult(pDb->interp) : "SQLITE_DENY";
1149 if( strcmp(zReply,"SQLITE_OK")==0 ){
1150 rc = SQLITE_OK;
1151 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
1152 rc = SQLITE_DENY;
1153 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
1154 rc = SQLITE_IGNORE;
1155 }else{
1156 rc = 999;
1157 }
1158 return rc;
1159 }
1160 #endif /* SQLITE_OMIT_AUTHORIZATION */
1161
1162 /*
1163 ** This routine reads a line of text from FILE in, stores
1164 ** the text in memory obtained from malloc() and returns a pointer
1165 ** to the text. NULL is returned at end of file, or if malloc()
1166 ** fails.
1167 **
1168 ** The interface is like "readline" but no command-line editing
1169 ** is done.
1170 **
1171 ** copied from shell.c from '.import' command
1172 */
local_getline(char * zPrompt,FILE * in)1173 static char *local_getline(char *zPrompt, FILE *in){
1174 char *zLine;
1175 int nLine;
1176 int n;
1177
1178 nLine = 100;
1179 zLine = malloc( nLine );
1180 if( zLine==0 ) return 0;
1181 n = 0;
1182 while( 1 ){
1183 if( n+100>nLine ){
1184 nLine = nLine*2 + 100;
1185 zLine = realloc(zLine, nLine);
1186 if( zLine==0 ) return 0;
1187 }
1188 if( fgets(&zLine[n], nLine - n, in)==0 ){
1189 if( n==0 ){
1190 free(zLine);
1191 return 0;
1192 }
1193 zLine[n] = 0;
1194 break;
1195 }
1196 while( zLine[n] ){ n++; }
1197 if( n>0 && zLine[n-1]=='\n' ){
1198 n--;
1199 zLine[n] = 0;
1200 break;
1201 }
1202 }
1203 zLine = realloc( zLine, n+1 );
1204 return zLine;
1205 }
1206
1207
1208 /*
1209 ** This function is part of the implementation of the command:
1210 **
1211 ** $db transaction [-deferred|-immediate|-exclusive] SCRIPT
1212 **
1213 ** It is invoked after evaluating the script SCRIPT to commit or rollback
1214 ** the transaction or savepoint opened by the [transaction] command.
1215 */
DbTransPostCmd(ClientData data[],Tcl_Interp * interp,int result)1216 static int SQLITE_TCLAPI DbTransPostCmd(
1217 ClientData data[], /* data[0] is the Sqlite3Db* for $db */
1218 Tcl_Interp *interp, /* Tcl interpreter */
1219 int result /* Result of evaluating SCRIPT */
1220 ){
1221 static const char *const azEnd[] = {
1222 "RELEASE _tcl_transaction", /* rc==TCL_ERROR, nTransaction!=0 */
1223 "COMMIT", /* rc!=TCL_ERROR, nTransaction==0 */
1224 "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
1225 "ROLLBACK" /* rc==TCL_ERROR, nTransaction==0 */
1226 };
1227 SqliteDb *pDb = (SqliteDb*)data[0];
1228 int rc = result;
1229 const char *zEnd;
1230
1231 pDb->nTransaction--;
1232 zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)];
1233
1234 pDb->disableAuth++;
1235 if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
1236 /* This is a tricky scenario to handle. The most likely cause of an
1237 ** error is that the exec() above was an attempt to commit the
1238 ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
1239 ** that an IO-error has occurred. In either case, throw a Tcl exception
1240 ** and try to rollback the transaction.
1241 **
1242 ** But it could also be that the user executed one or more BEGIN,
1243 ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
1244 ** this method's logic. Not clear how this would be best handled.
1245 */
1246 if( rc!=TCL_ERROR ){
1247 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
1248 rc = TCL_ERROR;
1249 }
1250 sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
1251 }
1252 pDb->disableAuth--;
1253
1254 return rc;
1255 }
1256
1257 /*
1258 ** Unless SQLITE_TEST is defined, this function is a simple wrapper around
1259 ** sqlite3_prepare_v2(). If SQLITE_TEST is defined, then it uses either
1260 ** sqlite3_prepare_v2() or legacy interface sqlite3_prepare(), depending
1261 ** on whether or not the [db_use_legacy_prepare] command has been used to
1262 ** configure the connection.
1263 */
dbPrepare(SqliteDb * pDb,const char * zSql,sqlite3_stmt ** ppStmt,const char ** pzOut)1264 static int dbPrepare(
1265 SqliteDb *pDb, /* Database object */
1266 const char *zSql, /* SQL to compile */
1267 sqlite3_stmt **ppStmt, /* OUT: Prepared statement */
1268 const char **pzOut /* OUT: Pointer to next SQL statement */
1269 ){
1270 unsigned int prepFlags = 0;
1271 #ifdef SQLITE_TEST
1272 if( pDb->bLegacyPrepare ){
1273 return sqlite3_prepare(pDb->db, zSql, -1, ppStmt, pzOut);
1274 }
1275 #endif
1276 /* If the statement cache is large, use the SQLITE_PREPARE_PERSISTENT
1277 ** flags, which uses less lookaside memory. But if the cache is small,
1278 ** omit that flag to make full use of lookaside */
1279 if( pDb->maxStmt>5 ) prepFlags = SQLITE_PREPARE_PERSISTENT;
1280
1281 return sqlite3_prepare_v3(pDb->db, zSql, -1, prepFlags, ppStmt, pzOut);
1282 }
1283
1284 /*
1285 ** Search the cache for a prepared-statement object that implements the
1286 ** first SQL statement in the buffer pointed to by parameter zIn. If
1287 ** no such prepared-statement can be found, allocate and prepare a new
1288 ** one. In either case, bind the current values of the relevant Tcl
1289 ** variables to any $var, :var or @var variables in the statement. Before
1290 ** returning, set *ppPreStmt to point to the prepared-statement object.
1291 **
1292 ** Output parameter *pzOut is set to point to the next SQL statement in
1293 ** buffer zIn, or to the '\0' byte at the end of zIn if there is no
1294 ** next statement.
1295 **
1296 ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned
1297 ** and an error message loaded into interpreter pDb->interp.
1298 */
dbPrepareAndBind(SqliteDb * pDb,char const * zIn,char const ** pzOut,SqlPreparedStmt ** ppPreStmt)1299 static int dbPrepareAndBind(
1300 SqliteDb *pDb, /* Database object */
1301 char const *zIn, /* SQL to compile */
1302 char const **pzOut, /* OUT: Pointer to next SQL statement */
1303 SqlPreparedStmt **ppPreStmt /* OUT: Object used to cache statement */
1304 ){
1305 const char *zSql = zIn; /* Pointer to first SQL statement in zIn */
1306 sqlite3_stmt *pStmt = 0; /* Prepared statement object */
1307 SqlPreparedStmt *pPreStmt; /* Pointer to cached statement */
1308 int nSql; /* Length of zSql in bytes */
1309 int nVar = 0; /* Number of variables in statement */
1310 int iParm = 0; /* Next free entry in apParm */
1311 char c;
1312 int i;
1313 int needResultReset = 0; /* Need to invoke Tcl_ResetResult() */
1314 int rc = SQLITE_OK; /* Value to return */
1315 Tcl_Interp *interp = pDb->interp;
1316
1317 *ppPreStmt = 0;
1318
1319 /* Trim spaces from the start of zSql and calculate the remaining length. */
1320 while( (c = zSql[0])==' ' || c=='\t' || c=='\r' || c=='\n' ){ zSql++; }
1321 nSql = strlen30(zSql);
1322
1323 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
1324 int n = pPreStmt->nSql;
1325 if( nSql>=n
1326 && memcmp(pPreStmt->zSql, zSql, n)==0
1327 && (zSql[n]==0 || zSql[n-1]==';')
1328 ){
1329 pStmt = pPreStmt->pStmt;
1330 *pzOut = &zSql[pPreStmt->nSql];
1331
1332 /* When a prepared statement is found, unlink it from the
1333 ** cache list. It will later be added back to the beginning
1334 ** of the cache list in order to implement LRU replacement.
1335 */
1336 if( pPreStmt->pPrev ){
1337 pPreStmt->pPrev->pNext = pPreStmt->pNext;
1338 }else{
1339 pDb->stmtList = pPreStmt->pNext;
1340 }
1341 if( pPreStmt->pNext ){
1342 pPreStmt->pNext->pPrev = pPreStmt->pPrev;
1343 }else{
1344 pDb->stmtLast = pPreStmt->pPrev;
1345 }
1346 pDb->nStmt--;
1347 nVar = sqlite3_bind_parameter_count(pStmt);
1348 break;
1349 }
1350 }
1351
1352 /* If no prepared statement was found. Compile the SQL text. Also allocate
1353 ** a new SqlPreparedStmt structure. */
1354 if( pPreStmt==0 ){
1355 int nByte;
1356
1357 if( SQLITE_OK!=dbPrepare(pDb, zSql, &pStmt, pzOut) ){
1358 Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1359 return TCL_ERROR;
1360 }
1361 if( pStmt==0 ){
1362 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
1363 /* A compile-time error in the statement. */
1364 Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1365 return TCL_ERROR;
1366 }else{
1367 /* The statement was a no-op. Continue to the next statement
1368 ** in the SQL string.
1369 */
1370 return TCL_OK;
1371 }
1372 }
1373
1374 assert( pPreStmt==0 );
1375 nVar = sqlite3_bind_parameter_count(pStmt);
1376 nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *);
1377 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte);
1378 memset(pPreStmt, 0, nByte);
1379
1380 pPreStmt->pStmt = pStmt;
1381 pPreStmt->nSql = (int)(*pzOut - zSql);
1382 pPreStmt->zSql = sqlite3_sql(pStmt);
1383 pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1];
1384 #ifdef SQLITE_TEST
1385 if( pPreStmt->zSql==0 ){
1386 char *zCopy = Tcl_Alloc(pPreStmt->nSql + 1);
1387 memcpy(zCopy, zSql, pPreStmt->nSql);
1388 zCopy[pPreStmt->nSql] = '\0';
1389 pPreStmt->zSql = zCopy;
1390 }
1391 #endif
1392 }
1393 assert( pPreStmt );
1394 assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
1395 assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
1396
1397 /* Bind values to parameters that begin with $ or : */
1398 for(i=1; i<=nVar; i++){
1399 const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
1400 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
1401 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
1402 if( pVar==0 && pDb->zBindFallback!=0 ){
1403 Tcl_Obj *pCmd;
1404 int rx;
1405 pCmd = Tcl_NewStringObj(pDb->zBindFallback, -1);
1406 Tcl_IncrRefCount(pCmd);
1407 Tcl_ListObjAppendElement(interp, pCmd, Tcl_NewStringObj(zVar,-1));
1408 if( needResultReset ) Tcl_ResetResult(interp);
1409 needResultReset = 1;
1410 rx = Tcl_EvalObjEx(interp, pCmd, TCL_EVAL_DIRECT);
1411 Tcl_DecrRefCount(pCmd);
1412 if( rx==TCL_OK ){
1413 pVar = Tcl_GetObjResult(interp);
1414 }else if( rx==TCL_ERROR ){
1415 rc = TCL_ERROR;
1416 break;
1417 }else{
1418 pVar = 0;
1419 }
1420 }
1421 if( pVar ){
1422 int n;
1423 u8 *data;
1424 const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
1425 c = zType[0];
1426 if( zVar[0]=='@' ||
1427 (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
1428 /* Load a BLOB type if the Tcl variable is a bytearray and
1429 ** it has no string representation or the host
1430 ** parameter name begins with "@". */
1431 data = Tcl_GetByteArrayFromObj(pVar, &n);
1432 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
1433 Tcl_IncrRefCount(pVar);
1434 pPreStmt->apParm[iParm++] = pVar;
1435 }else if( c=='b' && strcmp(zType,"boolean")==0 ){
1436 Tcl_GetIntFromObj(interp, pVar, &n);
1437 sqlite3_bind_int(pStmt, i, n);
1438 }else if( c=='d' && strcmp(zType,"double")==0 ){
1439 double r;
1440 Tcl_GetDoubleFromObj(interp, pVar, &r);
1441 sqlite3_bind_double(pStmt, i, r);
1442 }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
1443 (c=='i' && strcmp(zType,"int")==0) ){
1444 Tcl_WideInt v;
1445 Tcl_GetWideIntFromObj(interp, pVar, &v);
1446 sqlite3_bind_int64(pStmt, i, v);
1447 }else{
1448 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
1449 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
1450 Tcl_IncrRefCount(pVar);
1451 pPreStmt->apParm[iParm++] = pVar;
1452 }
1453 }else{
1454 sqlite3_bind_null(pStmt, i);
1455 }
1456 if( needResultReset ) Tcl_ResetResult(pDb->interp);
1457 }
1458 }
1459 pPreStmt->nParm = iParm;
1460 *ppPreStmt = pPreStmt;
1461 if( needResultReset && rc==TCL_OK ) Tcl_ResetResult(pDb->interp);
1462
1463 return rc;
1464 }
1465
1466 /*
1467 ** Release a statement reference obtained by calling dbPrepareAndBind().
1468 ** There should be exactly one call to this function for each call to
1469 ** dbPrepareAndBind().
1470 **
1471 ** If the discard parameter is non-zero, then the statement is deleted
1472 ** immediately. Otherwise it is added to the LRU list and may be returned
1473 ** by a subsequent call to dbPrepareAndBind().
1474 */
dbReleaseStmt(SqliteDb * pDb,SqlPreparedStmt * pPreStmt,int discard)1475 static void dbReleaseStmt(
1476 SqliteDb *pDb, /* Database handle */
1477 SqlPreparedStmt *pPreStmt, /* Prepared statement handle to release */
1478 int discard /* True to delete (not cache) the pPreStmt */
1479 ){
1480 int i;
1481
1482 /* Free the bound string and blob parameters */
1483 for(i=0; i<pPreStmt->nParm; i++){
1484 Tcl_DecrRefCount(pPreStmt->apParm[i]);
1485 }
1486 pPreStmt->nParm = 0;
1487
1488 if( pDb->maxStmt<=0 || discard ){
1489 /* If the cache is turned off, deallocated the statement */
1490 dbFreeStmt(pPreStmt);
1491 }else{
1492 /* Add the prepared statement to the beginning of the cache list. */
1493 pPreStmt->pNext = pDb->stmtList;
1494 pPreStmt->pPrev = 0;
1495 if( pDb->stmtList ){
1496 pDb->stmtList->pPrev = pPreStmt;
1497 }
1498 pDb->stmtList = pPreStmt;
1499 if( pDb->stmtLast==0 ){
1500 assert( pDb->nStmt==0 );
1501 pDb->stmtLast = pPreStmt;
1502 }else{
1503 assert( pDb->nStmt>0 );
1504 }
1505 pDb->nStmt++;
1506
1507 /* If we have too many statement in cache, remove the surplus from
1508 ** the end of the cache list. */
1509 while( pDb->nStmt>pDb->maxStmt ){
1510 SqlPreparedStmt *pLast = pDb->stmtLast;
1511 pDb->stmtLast = pLast->pPrev;
1512 pDb->stmtLast->pNext = 0;
1513 pDb->nStmt--;
1514 dbFreeStmt(pLast);
1515 }
1516 }
1517 }
1518
1519 /*
1520 ** Structure used with dbEvalXXX() functions:
1521 **
1522 ** dbEvalInit()
1523 ** dbEvalStep()
1524 ** dbEvalFinalize()
1525 ** dbEvalRowInfo()
1526 ** dbEvalColumnValue()
1527 */
1528 typedef struct DbEvalContext DbEvalContext;
1529 struct DbEvalContext {
1530 SqliteDb *pDb; /* Database handle */
1531 Tcl_Obj *pSql; /* Object holding string zSql */
1532 const char *zSql; /* Remaining SQL to execute */
1533 SqlPreparedStmt *pPreStmt; /* Current statement */
1534 int nCol; /* Number of columns returned by pStmt */
1535 int evalFlags; /* Flags used */
1536 Tcl_Obj *pArray; /* Name of array variable */
1537 Tcl_Obj **apColName; /* Array of column names */
1538 };
1539
1540 #define SQLITE_EVAL_WITHOUTNULLS 0x00001 /* Unset array(*) for NULL */
1541
1542 /*
1543 ** Release any cache of column names currently held as part of
1544 ** the DbEvalContext structure passed as the first argument.
1545 */
dbReleaseColumnNames(DbEvalContext * p)1546 static void dbReleaseColumnNames(DbEvalContext *p){
1547 if( p->apColName ){
1548 int i;
1549 for(i=0; i<p->nCol; i++){
1550 Tcl_DecrRefCount(p->apColName[i]);
1551 }
1552 Tcl_Free((char *)p->apColName);
1553 p->apColName = 0;
1554 }
1555 p->nCol = 0;
1556 }
1557
1558 /*
1559 ** Initialize a DbEvalContext structure.
1560 **
1561 ** If pArray is not NULL, then it contains the name of a Tcl array
1562 ** variable. The "*" member of this array is set to a list containing
1563 ** the names of the columns returned by the statement as part of each
1564 ** call to dbEvalStep(), in order from left to right. e.g. if the names
1565 ** of the returned columns are a, b and c, it does the equivalent of the
1566 ** tcl command:
1567 **
1568 ** set ${pArray}(*) {a b c}
1569 */
dbEvalInit(DbEvalContext * p,SqliteDb * pDb,Tcl_Obj * pSql,Tcl_Obj * pArray,int evalFlags)1570 static void dbEvalInit(
1571 DbEvalContext *p, /* Pointer to structure to initialize */
1572 SqliteDb *pDb, /* Database handle */
1573 Tcl_Obj *pSql, /* Object containing SQL script */
1574 Tcl_Obj *pArray, /* Name of Tcl array to set (*) element of */
1575 int evalFlags /* Flags controlling evaluation */
1576 ){
1577 memset(p, 0, sizeof(DbEvalContext));
1578 p->pDb = pDb;
1579 p->zSql = Tcl_GetString(pSql);
1580 p->pSql = pSql;
1581 Tcl_IncrRefCount(pSql);
1582 if( pArray ){
1583 p->pArray = pArray;
1584 Tcl_IncrRefCount(pArray);
1585 }
1586 p->evalFlags = evalFlags;
1587 }
1588
1589 /*
1590 ** Obtain information about the row that the DbEvalContext passed as the
1591 ** first argument currently points to.
1592 */
dbEvalRowInfo(DbEvalContext * p,int * pnCol,Tcl_Obj *** papColName)1593 static void dbEvalRowInfo(
1594 DbEvalContext *p, /* Evaluation context */
1595 int *pnCol, /* OUT: Number of column names */
1596 Tcl_Obj ***papColName /* OUT: Array of column names */
1597 ){
1598 /* Compute column names */
1599 if( 0==p->apColName ){
1600 sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1601 int i; /* Iterator variable */
1602 int nCol; /* Number of columns returned by pStmt */
1603 Tcl_Obj **apColName = 0; /* Array of column names */
1604
1605 p->nCol = nCol = sqlite3_column_count(pStmt);
1606 if( nCol>0 && (papColName || p->pArray) ){
1607 apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
1608 for(i=0; i<nCol; i++){
1609 apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
1610 Tcl_IncrRefCount(apColName[i]);
1611 }
1612 p->apColName = apColName;
1613 }
1614
1615 /* If results are being stored in an array variable, then create
1616 ** the array(*) entry for that array
1617 */
1618 if( p->pArray ){
1619 Tcl_Interp *interp = p->pDb->interp;
1620 Tcl_Obj *pColList = Tcl_NewObj();
1621 Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
1622
1623 for(i=0; i<nCol; i++){
1624 Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
1625 }
1626 Tcl_IncrRefCount(pStar);
1627 Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
1628 Tcl_DecrRefCount(pStar);
1629 }
1630 }
1631
1632 if( papColName ){
1633 *papColName = p->apColName;
1634 }
1635 if( pnCol ){
1636 *pnCol = p->nCol;
1637 }
1638 }
1639
1640 /*
1641 ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is
1642 ** returned, then an error message is stored in the interpreter before
1643 ** returning.
1644 **
1645 ** A return value of TCL_OK means there is a row of data available. The
1646 ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
1647 ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK
1648 ** is returned, then the SQL script has finished executing and there are
1649 ** no further rows available. This is similar to SQLITE_DONE.
1650 */
dbEvalStep(DbEvalContext * p)1651 static int dbEvalStep(DbEvalContext *p){
1652 const char *zPrevSql = 0; /* Previous value of p->zSql */
1653
1654 while( p->zSql[0] || p->pPreStmt ){
1655 int rc;
1656 if( p->pPreStmt==0 ){
1657 zPrevSql = (p->zSql==zPrevSql ? 0 : p->zSql);
1658 rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
1659 if( rc!=TCL_OK ) return rc;
1660 }else{
1661 int rcs;
1662 SqliteDb *pDb = p->pDb;
1663 SqlPreparedStmt *pPreStmt = p->pPreStmt;
1664 sqlite3_stmt *pStmt = pPreStmt->pStmt;
1665
1666 rcs = sqlite3_step(pStmt);
1667 if( rcs==SQLITE_ROW ){
1668 return TCL_OK;
1669 }
1670 if( p->pArray ){
1671 dbEvalRowInfo(p, 0, 0);
1672 }
1673 rcs = sqlite3_reset(pStmt);
1674
1675 pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
1676 pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
1677 pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);
1678 pDb->nVMStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_VM_STEP,1);
1679 dbReleaseColumnNames(p);
1680 p->pPreStmt = 0;
1681
1682 if( rcs!=SQLITE_OK ){
1683 /* If a run-time error occurs, report the error and stop reading
1684 ** the SQL. */
1685 dbReleaseStmt(pDb, pPreStmt, 1);
1686 #if SQLITE_TEST
1687 if( p->pDb->bLegacyPrepare && rcs==SQLITE_SCHEMA && zPrevSql ){
1688 /* If the runtime error was an SQLITE_SCHEMA, and the database
1689 ** handle is configured to use the legacy sqlite3_prepare()
1690 ** interface, retry prepare()/step() on the same SQL statement.
1691 ** This only happens once. If there is a second SQLITE_SCHEMA
1692 ** error, the error will be returned to the caller. */
1693 p->zSql = zPrevSql;
1694 continue;
1695 }
1696 #endif
1697 Tcl_SetObjResult(pDb->interp,
1698 Tcl_NewStringObj(sqlite3_errmsg(pDb->db), -1));
1699 return TCL_ERROR;
1700 }else{
1701 dbReleaseStmt(pDb, pPreStmt, 0);
1702 }
1703 }
1704 }
1705
1706 /* Finished */
1707 return TCL_BREAK;
1708 }
1709
1710 /*
1711 ** Free all resources currently held by the DbEvalContext structure passed
1712 ** as the first argument. There should be exactly one call to this function
1713 ** for each call to dbEvalInit().
1714 */
dbEvalFinalize(DbEvalContext * p)1715 static void dbEvalFinalize(DbEvalContext *p){
1716 if( p->pPreStmt ){
1717 sqlite3_reset(p->pPreStmt->pStmt);
1718 dbReleaseStmt(p->pDb, p->pPreStmt, 0);
1719 p->pPreStmt = 0;
1720 }
1721 if( p->pArray ){
1722 Tcl_DecrRefCount(p->pArray);
1723 p->pArray = 0;
1724 }
1725 Tcl_DecrRefCount(p->pSql);
1726 dbReleaseColumnNames(p);
1727 }
1728
1729 /*
1730 ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains
1731 ** the value for the iCol'th column of the row currently pointed to by
1732 ** the DbEvalContext structure passed as the first argument.
1733 */
dbEvalColumnValue(DbEvalContext * p,int iCol)1734 static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){
1735 sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1736 switch( sqlite3_column_type(pStmt, iCol) ){
1737 case SQLITE_BLOB: {
1738 int bytes = sqlite3_column_bytes(pStmt, iCol);
1739 const char *zBlob = sqlite3_column_blob(pStmt, iCol);
1740 if( !zBlob ) bytes = 0;
1741 return Tcl_NewByteArrayObj((u8*)zBlob, bytes);
1742 }
1743 case SQLITE_INTEGER: {
1744 sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
1745 if( v>=-2147483647 && v<=2147483647 ){
1746 return Tcl_NewIntObj((int)v);
1747 }else{
1748 return Tcl_NewWideIntObj(v);
1749 }
1750 }
1751 case SQLITE_FLOAT: {
1752 return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
1753 }
1754 case SQLITE_NULL: {
1755 return Tcl_NewStringObj(p->pDb->zNull, -1);
1756 }
1757 }
1758
1759 return Tcl_NewStringObj((char*)sqlite3_column_text(pStmt, iCol), -1);
1760 }
1761
1762 /*
1763 ** If using Tcl version 8.6 or greater, use the NR functions to avoid
1764 ** recursive evalution of scripts by the [db eval] and [db trans]
1765 ** commands. Even if the headers used while compiling the extension
1766 ** are 8.6 or newer, the code still tests the Tcl version at runtime.
1767 ** This allows stubs-enabled builds to be used with older Tcl libraries.
1768 */
1769 #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
1770 # define SQLITE_TCL_NRE 1
DbUseNre(void)1771 static int DbUseNre(void){
1772 int major, minor;
1773 Tcl_GetVersion(&major, &minor, 0, 0);
1774 return( (major==8 && minor>=6) || major>8 );
1775 }
1776 #else
1777 /*
1778 ** Compiling using headers earlier than 8.6. In this case NR cannot be
1779 ** used, so DbUseNre() to always return zero. Add #defines for the other
1780 ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
1781 ** even though the only invocations of them are within conditional blocks
1782 ** of the form:
1783 **
1784 ** if( DbUseNre() ) { ... }
1785 */
1786 # define SQLITE_TCL_NRE 0
1787 # define DbUseNre() 0
1788 # define Tcl_NRAddCallback(a,b,c,d,e,f) (void)0
1789 # define Tcl_NREvalObj(a,b,c) 0
1790 # define Tcl_NRCreateCommand(a,b,c,d,e,f) (void)0
1791 #endif
1792
1793 /*
1794 ** This function is part of the implementation of the command:
1795 **
1796 ** $db eval SQL ?ARRAYNAME? SCRIPT
1797 */
DbEvalNextCmd(ClientData data[],Tcl_Interp * interp,int result)1798 static int SQLITE_TCLAPI DbEvalNextCmd(
1799 ClientData data[], /* data[0] is the (DbEvalContext*) */
1800 Tcl_Interp *interp, /* Tcl interpreter */
1801 int result /* Result so far */
1802 ){
1803 int rc = result; /* Return code */
1804
1805 /* The first element of the data[] array is a pointer to a DbEvalContext
1806 ** structure allocated using Tcl_Alloc(). The second element of data[]
1807 ** is a pointer to a Tcl_Obj containing the script to run for each row
1808 ** returned by the queries encapsulated in data[0]. */
1809 DbEvalContext *p = (DbEvalContext *)data[0];
1810 Tcl_Obj *pScript = (Tcl_Obj *)data[1];
1811 Tcl_Obj *pArray = p->pArray;
1812
1813 while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
1814 int i;
1815 int nCol;
1816 Tcl_Obj **apColName;
1817 dbEvalRowInfo(p, &nCol, &apColName);
1818 for(i=0; i<nCol; i++){
1819 if( pArray==0 ){
1820 Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
1821 }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
1822 && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL
1823 ){
1824 Tcl_UnsetVar2(interp, Tcl_GetString(pArray),
1825 Tcl_GetString(apColName[i]), 0);
1826 }else{
1827 Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
1828 }
1829 }
1830
1831 /* The required interpreter variables are now populated with the data
1832 ** from the current row. If using NRE, schedule callbacks to evaluate
1833 ** script pScript, then to invoke this function again to fetch the next
1834 ** row (or clean up if there is no next row or the script throws an
1835 ** exception). After scheduling the callbacks, return control to the
1836 ** caller.
1837 **
1838 ** If not using NRE, evaluate pScript directly and continue with the
1839 ** next iteration of this while(...) loop. */
1840 if( DbUseNre() ){
1841 Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0);
1842 return Tcl_NREvalObj(interp, pScript, 0);
1843 }else{
1844 rc = Tcl_EvalObjEx(interp, pScript, 0);
1845 }
1846 }
1847
1848 Tcl_DecrRefCount(pScript);
1849 dbEvalFinalize(p);
1850 Tcl_Free((char *)p);
1851
1852 if( rc==TCL_OK || rc==TCL_BREAK ){
1853 Tcl_ResetResult(interp);
1854 rc = TCL_OK;
1855 }
1856 return rc;
1857 }
1858
1859 /*
1860 ** This function is used by the implementations of the following database
1861 ** handle sub-commands:
1862 **
1863 ** $db update_hook ?SCRIPT?
1864 ** $db wal_hook ?SCRIPT?
1865 ** $db commit_hook ?SCRIPT?
1866 ** $db preupdate hook ?SCRIPT?
1867 */
DbHookCmd(Tcl_Interp * interp,SqliteDb * pDb,Tcl_Obj * pArg,Tcl_Obj ** ppHook)1868 static void DbHookCmd(
1869 Tcl_Interp *interp, /* Tcl interpreter */
1870 SqliteDb *pDb, /* Database handle */
1871 Tcl_Obj *pArg, /* SCRIPT argument (or NULL) */
1872 Tcl_Obj **ppHook /* Pointer to member of SqliteDb */
1873 ){
1874 sqlite3 *db = pDb->db;
1875
1876 if( *ppHook ){
1877 Tcl_SetObjResult(interp, *ppHook);
1878 if( pArg ){
1879 Tcl_DecrRefCount(*ppHook);
1880 *ppHook = 0;
1881 }
1882 }
1883 if( pArg ){
1884 assert( !(*ppHook) );
1885 if( Tcl_GetCharLength(pArg)>0 ){
1886 *ppHook = pArg;
1887 Tcl_IncrRefCount(*ppHook);
1888 }
1889 }
1890
1891 #ifdef SQLITE_ENABLE_PREUPDATE_HOOK
1892 sqlite3_preupdate_hook(db, (pDb->pPreUpdateHook?DbPreUpdateHandler:0), pDb);
1893 #endif
1894 sqlite3_update_hook(db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
1895 sqlite3_rollback_hook(db, (pDb->pRollbackHook?DbRollbackHandler:0), pDb);
1896 sqlite3_wal_hook(db, (pDb->pWalHook?DbWalHandler:0), pDb);
1897 }
1898
1899 /*
1900 ** The "sqlite" command below creates a new Tcl command for each
1901 ** connection it opens to an SQLite database. This routine is invoked
1902 ** whenever one of those connection-specific commands is executed
1903 ** in Tcl. For example, if you run Tcl code like this:
1904 **
1905 ** sqlite3 db1 "my_database"
1906 ** db1 close
1907 **
1908 ** The first command opens a connection to the "my_database" database
1909 ** and calls that connection "db1". The second command causes this
1910 ** subroutine to be invoked.
1911 */
DbObjCmd(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)1912 static int SQLITE_TCLAPI DbObjCmd(
1913 void *cd,
1914 Tcl_Interp *interp,
1915 int objc,
1916 Tcl_Obj *const*objv
1917 ){
1918 SqliteDb *pDb = (SqliteDb*)cd;
1919 int choice;
1920 int rc = TCL_OK;
1921 static const char *DB_strs[] = {
1922 "authorizer", "backup", "bind_fallback",
1923 "busy", "cache", "changes",
1924 "close", "collate", "collation_needed",
1925 "commit_hook", "complete", "config",
1926 "copy", "deserialize", "enable_load_extension",
1927 "errorcode", "eval", "exists",
1928 "function", "incrblob", "interrupt",
1929 "last_insert_rowid", "nullvalue", "onecolumn",
1930 "preupdate", "profile", "progress",
1931 "rekey", "restore", "rollback_hook",
1932 "serialize", "status", "timeout",
1933 "total_changes", "trace", "trace_v2",
1934 "transaction", "unlock_notify", "update_hook",
1935 "version", "wal_hook", 0
1936 };
1937 enum DB_enum {
1938 DB_AUTHORIZER, DB_BACKUP, DB_BIND_FALLBACK,
1939 DB_BUSY, DB_CACHE, DB_CHANGES,
1940 DB_CLOSE, DB_COLLATE, DB_COLLATION_NEEDED,
1941 DB_COMMIT_HOOK, DB_COMPLETE, DB_CONFIG,
1942 DB_COPY, DB_DESERIALIZE, DB_ENABLE_LOAD_EXTENSION,
1943 DB_ERRORCODE, DB_EVAL, DB_EXISTS,
1944 DB_FUNCTION, DB_INCRBLOB, DB_INTERRUPT,
1945 DB_LAST_INSERT_ROWID, DB_NULLVALUE, DB_ONECOLUMN,
1946 DB_PREUPDATE, DB_PROFILE, DB_PROGRESS,
1947 DB_REKEY, DB_RESTORE, DB_ROLLBACK_HOOK,
1948 DB_SERIALIZE, DB_STATUS, DB_TIMEOUT,
1949 DB_TOTAL_CHANGES, DB_TRACE, DB_TRACE_V2,
1950 DB_TRANSACTION, DB_UNLOCK_NOTIFY, DB_UPDATE_HOOK,
1951 DB_VERSION, DB_WAL_HOOK
1952 };
1953 /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
1954
1955 if( objc<2 ){
1956 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
1957 return TCL_ERROR;
1958 }
1959 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
1960 return TCL_ERROR;
1961 }
1962
1963 switch( (enum DB_enum)choice ){
1964
1965 /* $db authorizer ?CALLBACK?
1966 **
1967 ** Invoke the given callback to authorize each SQL operation as it is
1968 ** compiled. 5 arguments are appended to the callback before it is
1969 ** invoked:
1970 **
1971 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
1972 ** (2) First descriptive name (depends on authorization type)
1973 ** (3) Second descriptive name
1974 ** (4) Name of the database (ex: "main", "temp")
1975 ** (5) Name of trigger that is doing the access
1976 **
1977 ** The callback should return on of the following strings: SQLITE_OK,
1978 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
1979 **
1980 ** If this method is invoked with no arguments, the current authorization
1981 ** callback string is returned.
1982 */
1983 case DB_AUTHORIZER: {
1984 #ifdef SQLITE_OMIT_AUTHORIZATION
1985 Tcl_AppendResult(interp, "authorization not available in this build",
1986 (char*)0);
1987 return TCL_ERROR;
1988 #else
1989 if( objc>3 ){
1990 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
1991 return TCL_ERROR;
1992 }else if( objc==2 ){
1993 if( pDb->zAuth ){
1994 Tcl_AppendResult(interp, pDb->zAuth, (char*)0);
1995 }
1996 }else{
1997 char *zAuth;
1998 int len;
1999 if( pDb->zAuth ){
2000 Tcl_Free(pDb->zAuth);
2001 }
2002 zAuth = Tcl_GetStringFromObj(objv[2], &len);
2003 if( zAuth && len>0 ){
2004 pDb->zAuth = Tcl_Alloc( len + 1 );
2005 memcpy(pDb->zAuth, zAuth, len+1);
2006 }else{
2007 pDb->zAuth = 0;
2008 }
2009 if( pDb->zAuth ){
2010 typedef int (*sqlite3_auth_cb)(
2011 void*,int,const char*,const char*,
2012 const char*,const char*);
2013 pDb->interp = interp;
2014 sqlite3_set_authorizer(pDb->db,(sqlite3_auth_cb)auth_callback,pDb);
2015 }else{
2016 sqlite3_set_authorizer(pDb->db, 0, 0);
2017 }
2018 }
2019 #endif
2020 break;
2021 }
2022
2023 /* $db backup ?DATABASE? FILENAME
2024 **
2025 ** Open or create a database file named FILENAME. Transfer the
2026 ** content of local database DATABASE (default: "main") into the
2027 ** FILENAME database.
2028 */
2029 case DB_BACKUP: {
2030 const char *zDestFile;
2031 const char *zSrcDb;
2032 sqlite3 *pDest;
2033 sqlite3_backup *pBackup;
2034
2035 if( objc==3 ){
2036 zSrcDb = "main";
2037 zDestFile = Tcl_GetString(objv[2]);
2038 }else if( objc==4 ){
2039 zSrcDb = Tcl_GetString(objv[2]);
2040 zDestFile = Tcl_GetString(objv[3]);
2041 }else{
2042 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
2043 return TCL_ERROR;
2044 }
2045 rc = sqlite3_open_v2(zDestFile, &pDest,
2046 SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE| pDb->openFlags, 0);
2047 if( rc!=SQLITE_OK ){
2048 Tcl_AppendResult(interp, "cannot open target database: ",
2049 sqlite3_errmsg(pDest), (char*)0);
2050 sqlite3_close(pDest);
2051 return TCL_ERROR;
2052 }
2053 pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
2054 if( pBackup==0 ){
2055 Tcl_AppendResult(interp, "backup failed: ",
2056 sqlite3_errmsg(pDest), (char*)0);
2057 sqlite3_close(pDest);
2058 return TCL_ERROR;
2059 }
2060 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
2061 sqlite3_backup_finish(pBackup);
2062 if( rc==SQLITE_DONE ){
2063 rc = TCL_OK;
2064 }else{
2065 Tcl_AppendResult(interp, "backup failed: ",
2066 sqlite3_errmsg(pDest), (char*)0);
2067 rc = TCL_ERROR;
2068 }
2069 sqlite3_close(pDest);
2070 break;
2071 }
2072
2073 /* $db bind_fallback ?CALLBACK?
2074 **
2075 ** When resolving bind parameters in an SQL statement, if the parameter
2076 ** cannot be associated with a TCL variable then invoke CALLBACK with a
2077 ** single argument that is the name of the parameter and use the return
2078 ** value of the CALLBACK as the binding. If CALLBACK returns something
2079 ** other than TCL_OK or TCL_ERROR then bind a NULL.
2080 **
2081 ** If CALLBACK is an empty string, then revert to the default behavior
2082 ** which is to set the binding to NULL.
2083 **
2084 ** If CALLBACK returns an error, that causes the statement execution to
2085 ** abort. Hence, to configure a connection so that it throws an error
2086 ** on an attempt to bind an unknown variable, do something like this:
2087 **
2088 ** proc bind_error {name} {error "no such variable: $name"}
2089 ** db bind_fallback bind_error
2090 */
2091 case DB_BIND_FALLBACK: {
2092 if( objc>3 ){
2093 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2094 return TCL_ERROR;
2095 }else if( objc==2 ){
2096 if( pDb->zBindFallback ){
2097 Tcl_AppendResult(interp, pDb->zBindFallback, (char*)0);
2098 }
2099 }else{
2100 char *zCallback;
2101 int len;
2102 if( pDb->zBindFallback ){
2103 Tcl_Free(pDb->zBindFallback);
2104 }
2105 zCallback = Tcl_GetStringFromObj(objv[2], &len);
2106 if( zCallback && len>0 ){
2107 pDb->zBindFallback = Tcl_Alloc( len + 1 );
2108 memcpy(pDb->zBindFallback, zCallback, len+1);
2109 }else{
2110 pDb->zBindFallback = 0;
2111 }
2112 }
2113 break;
2114 }
2115
2116 /* $db busy ?CALLBACK?
2117 **
2118 ** Invoke the given callback if an SQL statement attempts to open
2119 ** a locked database file.
2120 */
2121 case DB_BUSY: {
2122 if( objc>3 ){
2123 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
2124 return TCL_ERROR;
2125 }else if( objc==2 ){
2126 if( pDb->zBusy ){
2127 Tcl_AppendResult(interp, pDb->zBusy, (char*)0);
2128 }
2129 }else{
2130 char *zBusy;
2131 int len;
2132 if( pDb->zBusy ){
2133 Tcl_Free(pDb->zBusy);
2134 }
2135 zBusy = Tcl_GetStringFromObj(objv[2], &len);
2136 if( zBusy && len>0 ){
2137 pDb->zBusy = Tcl_Alloc( len + 1 );
2138 memcpy(pDb->zBusy, zBusy, len+1);
2139 }else{
2140 pDb->zBusy = 0;
2141 }
2142 if( pDb->zBusy ){
2143 pDb->interp = interp;
2144 sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
2145 }else{
2146 sqlite3_busy_handler(pDb->db, 0, 0);
2147 }
2148 }
2149 break;
2150 }
2151
2152 /* $db cache flush
2153 ** $db cache size n
2154 **
2155 ** Flush the prepared statement cache, or set the maximum number of
2156 ** cached statements.
2157 */
2158 case DB_CACHE: {
2159 char *subCmd;
2160 int n;
2161
2162 if( objc<=2 ){
2163 Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
2164 return TCL_ERROR;
2165 }
2166 subCmd = Tcl_GetStringFromObj( objv[2], 0 );
2167 if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
2168 if( objc!=3 ){
2169 Tcl_WrongNumArgs(interp, 2, objv, "flush");
2170 return TCL_ERROR;
2171 }else{
2172 flushStmtCache( pDb );
2173 }
2174 }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
2175 if( objc!=4 ){
2176 Tcl_WrongNumArgs(interp, 2, objv, "size n");
2177 return TCL_ERROR;
2178 }else{
2179 if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
2180 Tcl_AppendResult( interp, "cannot convert \"",
2181 Tcl_GetStringFromObj(objv[3],0), "\" to integer", (char*)0);
2182 return TCL_ERROR;
2183 }else{
2184 if( n<0 ){
2185 flushStmtCache( pDb );
2186 n = 0;
2187 }else if( n>MAX_PREPARED_STMTS ){
2188 n = MAX_PREPARED_STMTS;
2189 }
2190 pDb->maxStmt = n;
2191 }
2192 }
2193 }else{
2194 Tcl_AppendResult( interp, "bad option \"",
2195 Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size",
2196 (char*)0);
2197 return TCL_ERROR;
2198 }
2199 break;
2200 }
2201
2202 /* $db changes
2203 **
2204 ** Return the number of rows that were modified, inserted, or deleted by
2205 ** the most recent INSERT, UPDATE or DELETE statement, not including
2206 ** any changes made by trigger programs.
2207 */
2208 case DB_CHANGES: {
2209 Tcl_Obj *pResult;
2210 if( objc!=2 ){
2211 Tcl_WrongNumArgs(interp, 2, objv, "");
2212 return TCL_ERROR;
2213 }
2214 pResult = Tcl_GetObjResult(interp);
2215 Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
2216 break;
2217 }
2218
2219 /* $db close
2220 **
2221 ** Shutdown the database
2222 */
2223 case DB_CLOSE: {
2224 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
2225 break;
2226 }
2227
2228 /*
2229 ** $db collate NAME SCRIPT
2230 **
2231 ** Create a new SQL collation function called NAME. Whenever
2232 ** that function is called, invoke SCRIPT to evaluate the function.
2233 */
2234 case DB_COLLATE: {
2235 SqlCollate *pCollate;
2236 char *zName;
2237 char *zScript;
2238 int nScript;
2239 if( objc!=4 ){
2240 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
2241 return TCL_ERROR;
2242 }
2243 zName = Tcl_GetStringFromObj(objv[2], 0);
2244 zScript = Tcl_GetStringFromObj(objv[3], &nScript);
2245 pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
2246 if( pCollate==0 ) return TCL_ERROR;
2247 pCollate->interp = interp;
2248 pCollate->pNext = pDb->pCollate;
2249 pCollate->zScript = (char*)&pCollate[1];
2250 pDb->pCollate = pCollate;
2251 memcpy(pCollate->zScript, zScript, nScript+1);
2252 if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
2253 pCollate, tclSqlCollate) ){
2254 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
2255 return TCL_ERROR;
2256 }
2257 break;
2258 }
2259
2260 /*
2261 ** $db collation_needed SCRIPT
2262 **
2263 ** Create a new SQL collation function called NAME. Whenever
2264 ** that function is called, invoke SCRIPT to evaluate the function.
2265 */
2266 case DB_COLLATION_NEEDED: {
2267 if( objc!=3 ){
2268 Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
2269 return TCL_ERROR;
2270 }
2271 if( pDb->pCollateNeeded ){
2272 Tcl_DecrRefCount(pDb->pCollateNeeded);
2273 }
2274 pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
2275 Tcl_IncrRefCount(pDb->pCollateNeeded);
2276 sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
2277 break;
2278 }
2279
2280 /* $db commit_hook ?CALLBACK?
2281 **
2282 ** Invoke the given callback just before committing every SQL transaction.
2283 ** If the callback throws an exception or returns non-zero, then the
2284 ** transaction is aborted. If CALLBACK is an empty string, the callback
2285 ** is disabled.
2286 */
2287 case DB_COMMIT_HOOK: {
2288 if( objc>3 ){
2289 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2290 return TCL_ERROR;
2291 }else if( objc==2 ){
2292 if( pDb->zCommit ){
2293 Tcl_AppendResult(interp, pDb->zCommit, (char*)0);
2294 }
2295 }else{
2296 const char *zCommit;
2297 int len;
2298 if( pDb->zCommit ){
2299 Tcl_Free(pDb->zCommit);
2300 }
2301 zCommit = Tcl_GetStringFromObj(objv[2], &len);
2302 if( zCommit && len>0 ){
2303 pDb->zCommit = Tcl_Alloc( len + 1 );
2304 memcpy(pDb->zCommit, zCommit, len+1);
2305 }else{
2306 pDb->zCommit = 0;
2307 }
2308 if( pDb->zCommit ){
2309 pDb->interp = interp;
2310 sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
2311 }else{
2312 sqlite3_commit_hook(pDb->db, 0, 0);
2313 }
2314 }
2315 break;
2316 }
2317
2318 /* $db complete SQL
2319 **
2320 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
2321 ** additional lines of input are needed. This is similar to the
2322 ** built-in "info complete" command of Tcl.
2323 */
2324 case DB_COMPLETE: {
2325 #ifndef SQLITE_OMIT_COMPLETE
2326 Tcl_Obj *pResult;
2327 int isComplete;
2328 if( objc!=3 ){
2329 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
2330 return TCL_ERROR;
2331 }
2332 isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
2333 pResult = Tcl_GetObjResult(interp);
2334 Tcl_SetBooleanObj(pResult, isComplete);
2335 #endif
2336 break;
2337 }
2338
2339 /* $db config ?OPTION? ?BOOLEAN?
2340 **
2341 ** Configure the database connection using the sqlite3_db_config()
2342 ** interface.
2343 */
2344 case DB_CONFIG: {
2345 static const struct DbConfigChoices {
2346 const char *zName;
2347 int op;
2348 } aDbConfig[] = {
2349 { "defensive", SQLITE_DBCONFIG_DEFENSIVE },
2350 { "dqs_ddl", SQLITE_DBCONFIG_DQS_DDL },
2351 { "dqs_dml", SQLITE_DBCONFIG_DQS_DML },
2352 { "enable_fkey", SQLITE_DBCONFIG_ENABLE_FKEY },
2353 { "enable_qpsg", SQLITE_DBCONFIG_ENABLE_QPSG },
2354 { "enable_trigger", SQLITE_DBCONFIG_ENABLE_TRIGGER },
2355 { "enable_view", SQLITE_DBCONFIG_ENABLE_VIEW },
2356 { "fts3_tokenizer", SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER },
2357 { "legacy_alter_table", SQLITE_DBCONFIG_LEGACY_ALTER_TABLE },
2358 { "legacy_file_format", SQLITE_DBCONFIG_LEGACY_FILE_FORMAT },
2359 { "load_extension", SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION },
2360 { "no_ckpt_on_close", SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE },
2361 { "reset_database", SQLITE_DBCONFIG_RESET_DATABASE },
2362 { "trigger_eqp", SQLITE_DBCONFIG_TRIGGER_EQP },
2363 { "trusted_schema", SQLITE_DBCONFIG_TRUSTED_SCHEMA },
2364 { "writable_schema", SQLITE_DBCONFIG_WRITABLE_SCHEMA },
2365 };
2366 Tcl_Obj *pResult;
2367 int ii;
2368 if( objc>4 ){
2369 Tcl_WrongNumArgs(interp, 2, objv, "?OPTION? ?BOOLEAN?");
2370 return TCL_ERROR;
2371 }
2372 if( objc==2 ){
2373 /* With no arguments, list all configuration options and with the
2374 ** current value */
2375 pResult = Tcl_NewListObj(0,0);
2376 for(ii=0; ii<sizeof(aDbConfig)/sizeof(aDbConfig[0]); ii++){
2377 int v = 0;
2378 sqlite3_db_config(pDb->db, aDbConfig[ii].op, -1, &v);
2379 Tcl_ListObjAppendElement(interp, pResult,
2380 Tcl_NewStringObj(aDbConfig[ii].zName,-1));
2381 Tcl_ListObjAppendElement(interp, pResult,
2382 Tcl_NewIntObj(v));
2383 }
2384 }else{
2385 const char *zOpt = Tcl_GetString(objv[2]);
2386 int onoff = -1;
2387 int v = 0;
2388 if( zOpt[0]=='-' ) zOpt++;
2389 for(ii=0; ii<sizeof(aDbConfig)/sizeof(aDbConfig[0]); ii++){
2390 if( strcmp(aDbConfig[ii].zName, zOpt)==0 ) break;
2391 }
2392 if( ii>=sizeof(aDbConfig)/sizeof(aDbConfig[0]) ){
2393 Tcl_AppendResult(interp, "unknown config option: \"", zOpt,
2394 "\"", (void*)0);
2395 return TCL_ERROR;
2396 }
2397 if( objc==4 ){
2398 if( Tcl_GetBooleanFromObj(interp, objv[3], &onoff) ){
2399 return TCL_ERROR;
2400 }
2401 }
2402 sqlite3_db_config(pDb->db, aDbConfig[ii].op, onoff, &v);
2403 pResult = Tcl_NewIntObj(v);
2404 }
2405 Tcl_SetObjResult(interp, pResult);
2406 break;
2407 }
2408
2409 /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
2410 **
2411 ** Copy data into table from filename, optionally using SEPARATOR
2412 ** as column separators. If a column contains a null string, or the
2413 ** value of NULLINDICATOR, a NULL is inserted for the column.
2414 ** conflict-algorithm is one of the sqlite conflict algorithms:
2415 ** rollback, abort, fail, ignore, replace
2416 ** On success, return the number of lines processed, not necessarily same
2417 ** as 'db changes' due to conflict-algorithm selected.
2418 **
2419 ** This code is basically an implementation/enhancement of
2420 ** the sqlite3 shell.c ".import" command.
2421 **
2422 ** This command usage is equivalent to the sqlite2.x COPY statement,
2423 ** which imports file data into a table using the PostgreSQL COPY file format:
2424 ** $db copy $conflit_algo $table_name $filename \t \\N
2425 */
2426 case DB_COPY: {
2427 char *zTable; /* Insert data into this table */
2428 char *zFile; /* The file from which to extract data */
2429 char *zConflict; /* The conflict algorithm to use */
2430 sqlite3_stmt *pStmt; /* A statement */
2431 int nCol; /* Number of columns in the table */
2432 int nByte; /* Number of bytes in an SQL string */
2433 int i, j; /* Loop counters */
2434 int nSep; /* Number of bytes in zSep[] */
2435 int nNull; /* Number of bytes in zNull[] */
2436 char *zSql; /* An SQL statement */
2437 char *zLine; /* A single line of input from the file */
2438 char **azCol; /* zLine[] broken up into columns */
2439 const char *zCommit; /* How to commit changes */
2440 FILE *in; /* The input file */
2441 int lineno = 0; /* Line number of input file */
2442 char zLineNum[80]; /* Line number print buffer */
2443 Tcl_Obj *pResult; /* interp result */
2444
2445 const char *zSep;
2446 const char *zNull;
2447 if( objc<5 || objc>7 ){
2448 Tcl_WrongNumArgs(interp, 2, objv,
2449 "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
2450 return TCL_ERROR;
2451 }
2452 if( objc>=6 ){
2453 zSep = Tcl_GetStringFromObj(objv[5], 0);
2454 }else{
2455 zSep = "\t";
2456 }
2457 if( objc>=7 ){
2458 zNull = Tcl_GetStringFromObj(objv[6], 0);
2459 }else{
2460 zNull = "";
2461 }
2462 zConflict = Tcl_GetStringFromObj(objv[2], 0);
2463 zTable = Tcl_GetStringFromObj(objv[3], 0);
2464 zFile = Tcl_GetStringFromObj(objv[4], 0);
2465 nSep = strlen30(zSep);
2466 nNull = strlen30(zNull);
2467 if( nSep==0 ){
2468 Tcl_AppendResult(interp,"Error: non-null separator required for copy",
2469 (char*)0);
2470 return TCL_ERROR;
2471 }
2472 if(strcmp(zConflict, "rollback") != 0 &&
2473 strcmp(zConflict, "abort" ) != 0 &&
2474 strcmp(zConflict, "fail" ) != 0 &&
2475 strcmp(zConflict, "ignore" ) != 0 &&
2476 strcmp(zConflict, "replace" ) != 0 ) {
2477 Tcl_AppendResult(interp, "Error: \"", zConflict,
2478 "\", conflict-algorithm must be one of: rollback, "
2479 "abort, fail, ignore, or replace", (char*)0);
2480 return TCL_ERROR;
2481 }
2482 zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
2483 if( zSql==0 ){
2484 Tcl_AppendResult(interp, "Error: no such table: ", zTable, (char*)0);
2485 return TCL_ERROR;
2486 }
2487 nByte = strlen30(zSql);
2488 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
2489 sqlite3_free(zSql);
2490 if( rc ){
2491 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2492 nCol = 0;
2493 }else{
2494 nCol = sqlite3_column_count(pStmt);
2495 }
2496 sqlite3_finalize(pStmt);
2497 if( nCol==0 ) {
2498 return TCL_ERROR;
2499 }
2500 zSql = malloc( nByte + 50 + nCol*2 );
2501 if( zSql==0 ) {
2502 Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
2503 return TCL_ERROR;
2504 }
2505 sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
2506 zConflict, zTable);
2507 j = strlen30(zSql);
2508 for(i=1; i<nCol; i++){
2509 zSql[j++] = ',';
2510 zSql[j++] = '?';
2511 }
2512 zSql[j++] = ')';
2513 zSql[j] = 0;
2514 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
2515 free(zSql);
2516 if( rc ){
2517 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2518 sqlite3_finalize(pStmt);
2519 return TCL_ERROR;
2520 }
2521 in = fopen(zFile, "rb");
2522 if( in==0 ){
2523 Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, (char*)0);
2524 sqlite3_finalize(pStmt);
2525 return TCL_ERROR;
2526 }
2527 azCol = malloc( sizeof(azCol[0])*(nCol+1) );
2528 if( azCol==0 ) {
2529 Tcl_AppendResult(interp, "Error: can't malloc()", (char*)0);
2530 fclose(in);
2531 return TCL_ERROR;
2532 }
2533 (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
2534 zCommit = "COMMIT";
2535 while( (zLine = local_getline(0, in))!=0 ){
2536 char *z;
2537 lineno++;
2538 azCol[0] = zLine;
2539 for(i=0, z=zLine; *z; z++){
2540 if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
2541 *z = 0;
2542 i++;
2543 if( i<nCol ){
2544 azCol[i] = &z[nSep];
2545 z += nSep-1;
2546 }
2547 }
2548 }
2549 if( i+1!=nCol ){
2550 char *zErr;
2551 int nErr = strlen30(zFile) + 200;
2552 zErr = malloc(nErr);
2553 if( zErr ){
2554 sqlite3_snprintf(nErr, zErr,
2555 "Error: %s line %d: expected %d columns of data but found %d",
2556 zFile, lineno, nCol, i+1);
2557 Tcl_AppendResult(interp, zErr, (char*)0);
2558 free(zErr);
2559 }
2560 zCommit = "ROLLBACK";
2561 break;
2562 }
2563 for(i=0; i<nCol; i++){
2564 /* check for null data, if so, bind as null */
2565 if( (nNull>0 && strcmp(azCol[i], zNull)==0)
2566 || strlen30(azCol[i])==0
2567 ){
2568 sqlite3_bind_null(pStmt, i+1);
2569 }else{
2570 sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
2571 }
2572 }
2573 sqlite3_step(pStmt);
2574 rc = sqlite3_reset(pStmt);
2575 free(zLine);
2576 if( rc!=SQLITE_OK ){
2577 Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), (char*)0);
2578 zCommit = "ROLLBACK";
2579 break;
2580 }
2581 }
2582 free(azCol);
2583 fclose(in);
2584 sqlite3_finalize(pStmt);
2585 (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
2586
2587 if( zCommit[0] == 'C' ){
2588 /* success, set result as number of lines processed */
2589 pResult = Tcl_GetObjResult(interp);
2590 Tcl_SetIntObj(pResult, lineno);
2591 rc = TCL_OK;
2592 }else{
2593 /* failure, append lineno where failed */
2594 sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
2595 Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,
2596 (char*)0);
2597 rc = TCL_ERROR;
2598 }
2599 break;
2600 }
2601
2602 /*
2603 ** $db deserialize ?-maxsize N? ?-readonly BOOL? ?DATABASE? VALUE
2604 **
2605 ** Reopen DATABASE (default "main") using the content in $VALUE
2606 */
2607 case DB_DESERIALIZE: {
2608 #ifndef SQLITE_ENABLE_DESERIALIZE
2609 Tcl_AppendResult(interp, "MEMDB not available in this build",
2610 (char*)0);
2611 rc = TCL_ERROR;
2612 #else
2613 const char *zSchema = 0;
2614 Tcl_Obj *pValue = 0;
2615 unsigned char *pBA;
2616 unsigned char *pData;
2617 int len, xrc;
2618 sqlite3_int64 mxSize = 0;
2619 int i;
2620 int isReadonly = 0;
2621
2622
2623 if( objc<3 ){
2624 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? VALUE");
2625 rc = TCL_ERROR;
2626 break;
2627 }
2628 for(i=2; i<objc-1; i++){
2629 const char *z = Tcl_GetString(objv[i]);
2630 if( strcmp(z,"-maxsize")==0 && i<objc-2 ){
2631 rc = Tcl_GetWideIntFromObj(interp, objv[++i], &mxSize);
2632 if( rc ) goto deserialize_error;
2633 continue;
2634 }
2635 if( strcmp(z,"-readonly")==0 && i<objc-2 ){
2636 rc = Tcl_GetBooleanFromObj(interp, objv[++i], &isReadonly);
2637 if( rc ) goto deserialize_error;
2638 continue;
2639 }
2640 if( zSchema==0 && i==objc-2 && z[0]!='-' ){
2641 zSchema = z;
2642 continue;
2643 }
2644 Tcl_AppendResult(interp, "unknown option: ", z, (char*)0);
2645 rc = TCL_ERROR;
2646 goto deserialize_error;
2647 }
2648 pValue = objv[objc-1];
2649 pBA = Tcl_GetByteArrayFromObj(pValue, &len);
2650 pData = sqlite3_malloc64( len );
2651 if( pData==0 && len>0 ){
2652 Tcl_AppendResult(interp, "out of memory", (char*)0);
2653 rc = TCL_ERROR;
2654 }else{
2655 int flags;
2656 if( len>0 ) memcpy(pData, pBA, len);
2657 if( isReadonly ){
2658 flags = SQLITE_DESERIALIZE_FREEONCLOSE | SQLITE_DESERIALIZE_READONLY;
2659 }else{
2660 flags = SQLITE_DESERIALIZE_FREEONCLOSE | SQLITE_DESERIALIZE_RESIZEABLE;
2661 }
2662 xrc = sqlite3_deserialize(pDb->db, zSchema, pData, len, len, flags);
2663 if( xrc ){
2664 Tcl_AppendResult(interp, "unable to set MEMDB content", (char*)0);
2665 rc = TCL_ERROR;
2666 }
2667 if( mxSize>0 ){
2668 sqlite3_file_control(pDb->db, zSchema,SQLITE_FCNTL_SIZE_LIMIT,&mxSize);
2669 }
2670 }
2671 deserialize_error:
2672 #endif
2673 break;
2674 }
2675
2676 /*
2677 ** $db enable_load_extension BOOLEAN
2678 **
2679 ** Turn the extension loading feature on or off. It if off by
2680 ** default.
2681 */
2682 case DB_ENABLE_LOAD_EXTENSION: {
2683 #ifndef SQLITE_OMIT_LOAD_EXTENSION
2684 int onoff;
2685 if( objc!=3 ){
2686 Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
2687 return TCL_ERROR;
2688 }
2689 if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
2690 return TCL_ERROR;
2691 }
2692 sqlite3_enable_load_extension(pDb->db, onoff);
2693 break;
2694 #else
2695 Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
2696 (char*)0);
2697 return TCL_ERROR;
2698 #endif
2699 }
2700
2701 /*
2702 ** $db errorcode
2703 **
2704 ** Return the numeric error code that was returned by the most recent
2705 ** call to sqlite3_exec().
2706 */
2707 case DB_ERRORCODE: {
2708 Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
2709 break;
2710 }
2711
2712 /*
2713 ** $db exists $sql
2714 ** $db onecolumn $sql
2715 **
2716 ** The onecolumn method is the equivalent of:
2717 ** lindex [$db eval $sql] 0
2718 */
2719 case DB_EXISTS:
2720 case DB_ONECOLUMN: {
2721 Tcl_Obj *pResult = 0;
2722 DbEvalContext sEval;
2723 if( objc!=3 ){
2724 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
2725 return TCL_ERROR;
2726 }
2727
2728 dbEvalInit(&sEval, pDb, objv[2], 0, 0);
2729 rc = dbEvalStep(&sEval);
2730 if( choice==DB_ONECOLUMN ){
2731 if( rc==TCL_OK ){
2732 pResult = dbEvalColumnValue(&sEval, 0);
2733 }else if( rc==TCL_BREAK ){
2734 Tcl_ResetResult(interp);
2735 }
2736 }else if( rc==TCL_BREAK || rc==TCL_OK ){
2737 pResult = Tcl_NewBooleanObj(rc==TCL_OK);
2738 }
2739 dbEvalFinalize(&sEval);
2740 if( pResult ) Tcl_SetObjResult(interp, pResult);
2741
2742 if( rc==TCL_BREAK ){
2743 rc = TCL_OK;
2744 }
2745 break;
2746 }
2747
2748 /*
2749 ** $db eval ?options? $sql ?array? ?{ ...code... }?
2750 **
2751 ** The SQL statement in $sql is evaluated. For each row, the values are
2752 ** placed in elements of the array named "array" and ...code... is executed.
2753 ** If "array" and "code" are omitted, then no callback is every invoked.
2754 ** If "array" is an empty string, then the values are placed in variables
2755 ** that have the same name as the fields extracted by the query.
2756 */
2757 case DB_EVAL: {
2758 int evalFlags = 0;
2759 const char *zOpt;
2760 while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
2761 if( strcmp(zOpt, "-withoutnulls")==0 ){
2762 evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
2763 }
2764 else{
2765 Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
2766 return TCL_ERROR;
2767 }
2768 objc--;
2769 objv++;
2770 }
2771 if( objc<3 || objc>5 ){
2772 Tcl_WrongNumArgs(interp, 2, objv,
2773 "?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?");
2774 return TCL_ERROR;
2775 }
2776
2777 if( objc==3 ){
2778 DbEvalContext sEval;
2779 Tcl_Obj *pRet = Tcl_NewObj();
2780 Tcl_IncrRefCount(pRet);
2781 dbEvalInit(&sEval, pDb, objv[2], 0, 0);
2782 while( TCL_OK==(rc = dbEvalStep(&sEval)) ){
2783 int i;
2784 int nCol;
2785 dbEvalRowInfo(&sEval, &nCol, 0);
2786 for(i=0; i<nCol; i++){
2787 Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
2788 }
2789 }
2790 dbEvalFinalize(&sEval);
2791 if( rc==TCL_BREAK ){
2792 Tcl_SetObjResult(interp, pRet);
2793 rc = TCL_OK;
2794 }
2795 Tcl_DecrRefCount(pRet);
2796 }else{
2797 ClientData cd2[2];
2798 DbEvalContext *p;
2799 Tcl_Obj *pArray = 0;
2800 Tcl_Obj *pScript;
2801
2802 if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
2803 pArray = objv[3];
2804 }
2805 pScript = objv[objc-1];
2806 Tcl_IncrRefCount(pScript);
2807
2808 p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
2809 dbEvalInit(p, pDb, objv[2], pArray, evalFlags);
2810
2811 cd2[0] = (void *)p;
2812 cd2[1] = (void *)pScript;
2813 rc = DbEvalNextCmd(cd2, interp, TCL_OK);
2814 }
2815 break;
2816 }
2817
2818 /*
2819 ** $db function NAME [OPTIONS] SCRIPT
2820 **
2821 ** Create a new SQL function called NAME. Whenever that function is
2822 ** called, invoke SCRIPT to evaluate the function.
2823 **
2824 ** Options:
2825 ** --argcount N Function has exactly N arguments
2826 ** --deterministic The function is pure
2827 ** --directonly Prohibit use inside triggers and views
2828 ** --innocuous Has no side effects or information leaks
2829 ** --returntype TYPE Specify the return type of the function
2830 */
2831 case DB_FUNCTION: {
2832 int flags = SQLITE_UTF8;
2833 SqlFunc *pFunc;
2834 Tcl_Obj *pScript;
2835 char *zName;
2836 int nArg = -1;
2837 int i;
2838 int eType = SQLITE_NULL;
2839 if( objc<4 ){
2840 Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT");
2841 return TCL_ERROR;
2842 }
2843 for(i=3; i<(objc-1); i++){
2844 const char *z = Tcl_GetString(objv[i]);
2845 int n = strlen30(z);
2846 if( n>1 && strncmp(z, "-argcount",n)==0 ){
2847 if( i==(objc-2) ){
2848 Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
2849 return TCL_ERROR;
2850 }
2851 if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR;
2852 if( nArg<0 ){
2853 Tcl_AppendResult(interp, "number of arguments must be non-negative",
2854 (char*)0);
2855 return TCL_ERROR;
2856 }
2857 i++;
2858 }else
2859 if( n>1 && strncmp(z, "-deterministic",n)==0 ){
2860 flags |= SQLITE_DETERMINISTIC;
2861 }else
2862 if( n>1 && strncmp(z, "-directonly",n)==0 ){
2863 flags |= SQLITE_DIRECTONLY;
2864 }else
2865 if( n>1 && strncmp(z, "-innocuous",n)==0 ){
2866 flags |= SQLITE_INNOCUOUS;
2867 }else
2868 if( n>1 && strncmp(z, "-returntype", n)==0 ){
2869 const char *azType[] = {"integer", "real", "text", "blob", "any", 0};
2870 assert( SQLITE_INTEGER==1 && SQLITE_FLOAT==2 && SQLITE_TEXT==3 );
2871 assert( SQLITE_BLOB==4 && SQLITE_NULL==5 );
2872 if( i==(objc-2) ){
2873 Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0);
2874 return TCL_ERROR;
2875 }
2876 i++;
2877 if( Tcl_GetIndexFromObj(interp, objv[i], azType, "type", 0, &eType) ){
2878 return TCL_ERROR;
2879 }
2880 eType++;
2881 }else{
2882 Tcl_AppendResult(interp, "bad option \"", z,
2883 "\": must be -argcount, -deterministic, -directonly,"
2884 " -innocuous, or -returntype", (char*)0
2885 );
2886 return TCL_ERROR;
2887 }
2888 }
2889
2890 pScript = objv[objc-1];
2891 zName = Tcl_GetStringFromObj(objv[2], 0);
2892 pFunc = findSqlFunc(pDb, zName);
2893 if( pFunc==0 ) return TCL_ERROR;
2894 if( pFunc->pScript ){
2895 Tcl_DecrRefCount(pFunc->pScript);
2896 }
2897 pFunc->pScript = pScript;
2898 Tcl_IncrRefCount(pScript);
2899 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
2900 pFunc->eType = eType;
2901 rc = sqlite3_create_function(pDb->db, zName, nArg, flags,
2902 pFunc, tclSqlFunc, 0, 0);
2903 if( rc!=SQLITE_OK ){
2904 rc = TCL_ERROR;
2905 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
2906 }
2907 break;
2908 }
2909
2910 /*
2911 ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
2912 */
2913 case DB_INCRBLOB: {
2914 #ifdef SQLITE_OMIT_INCRBLOB
2915 Tcl_AppendResult(interp, "incrblob not available in this build", (char*)0);
2916 return TCL_ERROR;
2917 #else
2918 int isReadonly = 0;
2919 const char *zDb = "main";
2920 const char *zTable;
2921 const char *zColumn;
2922 Tcl_WideInt iRow;
2923
2924 /* Check for the -readonly option */
2925 if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
2926 isReadonly = 1;
2927 }
2928
2929 if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
2930 Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
2931 return TCL_ERROR;
2932 }
2933
2934 if( objc==(6+isReadonly) ){
2935 zDb = Tcl_GetString(objv[2]);
2936 }
2937 zTable = Tcl_GetString(objv[objc-3]);
2938 zColumn = Tcl_GetString(objv[objc-2]);
2939 rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
2940
2941 if( rc==TCL_OK ){
2942 rc = createIncrblobChannel(
2943 interp, pDb, zDb, zTable, zColumn, (sqlite3_int64)iRow, isReadonly
2944 );
2945 }
2946 #endif
2947 break;
2948 }
2949
2950 /*
2951 ** $db interrupt
2952 **
2953 ** Interrupt the execution of the inner-most SQL interpreter. This
2954 ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
2955 */
2956 case DB_INTERRUPT: {
2957 sqlite3_interrupt(pDb->db);
2958 break;
2959 }
2960
2961 /*
2962 ** $db nullvalue ?STRING?
2963 **
2964 ** Change text used when a NULL comes back from the database. If ?STRING?
2965 ** is not present, then the current string used for NULL is returned.
2966 ** If STRING is present, then STRING is returned.
2967 **
2968 */
2969 case DB_NULLVALUE: {
2970 if( objc!=2 && objc!=3 ){
2971 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
2972 return TCL_ERROR;
2973 }
2974 if( objc==3 ){
2975 int len;
2976 char *zNull = Tcl_GetStringFromObj(objv[2], &len);
2977 if( pDb->zNull ){
2978 Tcl_Free(pDb->zNull);
2979 }
2980 if( zNull && len>0 ){
2981 pDb->zNull = Tcl_Alloc( len + 1 );
2982 memcpy(pDb->zNull, zNull, len);
2983 pDb->zNull[len] = '\0';
2984 }else{
2985 pDb->zNull = 0;
2986 }
2987 }
2988 Tcl_SetObjResult(interp, Tcl_NewStringObj(pDb->zNull, -1));
2989 break;
2990 }
2991
2992 /*
2993 ** $db last_insert_rowid
2994 **
2995 ** Return an integer which is the ROWID for the most recent insert.
2996 */
2997 case DB_LAST_INSERT_ROWID: {
2998 Tcl_Obj *pResult;
2999 Tcl_WideInt rowid;
3000 if( objc!=2 ){
3001 Tcl_WrongNumArgs(interp, 2, objv, "");
3002 return TCL_ERROR;
3003 }
3004 rowid = sqlite3_last_insert_rowid(pDb->db);
3005 pResult = Tcl_GetObjResult(interp);
3006 Tcl_SetWideIntObj(pResult, rowid);
3007 break;
3008 }
3009
3010 /*
3011 ** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
3012 */
3013
3014 /* $db progress ?N CALLBACK?
3015 **
3016 ** Invoke the given callback every N virtual machine opcodes while executing
3017 ** queries.
3018 */
3019 case DB_PROGRESS: {
3020 if( objc==2 ){
3021 if( pDb->zProgress ){
3022 Tcl_AppendResult(interp, pDb->zProgress, (char*)0);
3023 }
3024 }else if( objc==4 ){
3025 char *zProgress;
3026 int len;
3027 int N;
3028 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
3029 return TCL_ERROR;
3030 };
3031 if( pDb->zProgress ){
3032 Tcl_Free(pDb->zProgress);
3033 }
3034 zProgress = Tcl_GetStringFromObj(objv[3], &len);
3035 if( zProgress && len>0 ){
3036 pDb->zProgress = Tcl_Alloc( len + 1 );
3037 memcpy(pDb->zProgress, zProgress, len+1);
3038 }else{
3039 pDb->zProgress = 0;
3040 }
3041 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
3042 if( pDb->zProgress ){
3043 pDb->interp = interp;
3044 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
3045 }else{
3046 sqlite3_progress_handler(pDb->db, 0, 0, 0);
3047 }
3048 #endif
3049 }else{
3050 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
3051 return TCL_ERROR;
3052 }
3053 break;
3054 }
3055
3056 /* $db profile ?CALLBACK?
3057 **
3058 ** Make arrangements to invoke the CALLBACK routine after each SQL statement
3059 ** that has run. The text of the SQL and the amount of elapse time are
3060 ** appended to CALLBACK before the script is run.
3061 */
3062 case DB_PROFILE: {
3063 if( objc>3 ){
3064 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
3065 return TCL_ERROR;
3066 }else if( objc==2 ){
3067 if( pDb->zProfile ){
3068 Tcl_AppendResult(interp, pDb->zProfile, (char*)0);
3069 }
3070 }else{
3071 char *zProfile;
3072 int len;
3073 if( pDb->zProfile ){
3074 Tcl_Free(pDb->zProfile);
3075 }
3076 zProfile = Tcl_GetStringFromObj(objv[2], &len);
3077 if( zProfile && len>0 ){
3078 pDb->zProfile = Tcl_Alloc( len + 1 );
3079 memcpy(pDb->zProfile, zProfile, len+1);
3080 }else{
3081 pDb->zProfile = 0;
3082 }
3083 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
3084 !defined(SQLITE_OMIT_DEPRECATED)
3085 if( pDb->zProfile ){
3086 pDb->interp = interp;
3087 sqlite3_profile(pDb->db, DbProfileHandler, pDb);
3088 }else{
3089 sqlite3_profile(pDb->db, 0, 0);
3090 }
3091 #endif
3092 }
3093 break;
3094 }
3095
3096 /*
3097 ** $db rekey KEY
3098 **
3099 ** Change the encryption key on the currently open database.
3100 */
3101 case DB_REKEY: {
3102 if( objc!=3 ){
3103 Tcl_WrongNumArgs(interp, 2, objv, "KEY");
3104 return TCL_ERROR;
3105 }
3106 break;
3107 }
3108
3109 /* $db restore ?DATABASE? FILENAME
3110 **
3111 ** Open a database file named FILENAME. Transfer the content
3112 ** of FILENAME into the local database DATABASE (default: "main").
3113 */
3114 case DB_RESTORE: {
3115 const char *zSrcFile;
3116 const char *zDestDb;
3117 sqlite3 *pSrc;
3118 sqlite3_backup *pBackup;
3119 int nTimeout = 0;
3120
3121 if( objc==3 ){
3122 zDestDb = "main";
3123 zSrcFile = Tcl_GetString(objv[2]);
3124 }else if( objc==4 ){
3125 zDestDb = Tcl_GetString(objv[2]);
3126 zSrcFile = Tcl_GetString(objv[3]);
3127 }else{
3128 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
3129 return TCL_ERROR;
3130 }
3131 rc = sqlite3_open_v2(zSrcFile, &pSrc,
3132 SQLITE_OPEN_READONLY | pDb->openFlags, 0);
3133 if( rc!=SQLITE_OK ){
3134 Tcl_AppendResult(interp, "cannot open source database: ",
3135 sqlite3_errmsg(pSrc), (char*)0);
3136 sqlite3_close(pSrc);
3137 return TCL_ERROR;
3138 }
3139 pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
3140 if( pBackup==0 ){
3141 Tcl_AppendResult(interp, "restore failed: ",
3142 sqlite3_errmsg(pDb->db), (char*)0);
3143 sqlite3_close(pSrc);
3144 return TCL_ERROR;
3145 }
3146 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
3147 || rc==SQLITE_BUSY ){
3148 if( rc==SQLITE_BUSY ){
3149 if( nTimeout++ >= 3 ) break;
3150 sqlite3_sleep(100);
3151 }
3152 }
3153 sqlite3_backup_finish(pBackup);
3154 if( rc==SQLITE_DONE ){
3155 rc = TCL_OK;
3156 }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){
3157 Tcl_AppendResult(interp, "restore failed: source database busy",
3158 (char*)0);
3159 rc = TCL_ERROR;
3160 }else{
3161 Tcl_AppendResult(interp, "restore failed: ",
3162 sqlite3_errmsg(pDb->db), (char*)0);
3163 rc = TCL_ERROR;
3164 }
3165 sqlite3_close(pSrc);
3166 break;
3167 }
3168
3169 /*
3170 ** $db serialize ?DATABASE?
3171 **
3172 ** Return a serialization of a database.
3173 */
3174 case DB_SERIALIZE: {
3175 #ifndef SQLITE_ENABLE_DESERIALIZE
3176 Tcl_AppendResult(interp, "MEMDB not available in this build",
3177 (char*)0);
3178 rc = TCL_ERROR;
3179 #else
3180 const char *zSchema = objc>=3 ? Tcl_GetString(objv[2]) : "main";
3181 sqlite3_int64 sz = 0;
3182 unsigned char *pData;
3183 if( objc!=2 && objc!=3 ){
3184 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE?");
3185 rc = TCL_ERROR;
3186 }else{
3187 int needFree;
3188 pData = sqlite3_serialize(pDb->db, zSchema, &sz, SQLITE_SERIALIZE_NOCOPY);
3189 if( pData ){
3190 needFree = 0;
3191 }else{
3192 pData = sqlite3_serialize(pDb->db, zSchema, &sz, 0);
3193 needFree = 1;
3194 }
3195 Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(pData,sz));
3196 if( needFree ) sqlite3_free(pData);
3197 }
3198 #endif
3199 break;
3200 }
3201
3202 /*
3203 ** $db status (step|sort|autoindex|vmstep)
3204 **
3205 ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
3206 ** SQLITE_STMTSTATUS_SORT for the most recent eval.
3207 */
3208 case DB_STATUS: {
3209 int v;
3210 const char *zOp;
3211 if( objc!=3 ){
3212 Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)");
3213 return TCL_ERROR;
3214 }
3215 zOp = Tcl_GetString(objv[2]);
3216 if( strcmp(zOp, "step")==0 ){
3217 v = pDb->nStep;
3218 }else if( strcmp(zOp, "sort")==0 ){
3219 v = pDb->nSort;
3220 }else if( strcmp(zOp, "autoindex")==0 ){
3221 v = pDb->nIndex;
3222 }else if( strcmp(zOp, "vmstep")==0 ){
3223 v = pDb->nVMStep;
3224 }else{
3225 Tcl_AppendResult(interp,
3226 "bad argument: should be autoindex, step, sort or vmstep",
3227 (char*)0);
3228 return TCL_ERROR;
3229 }
3230 Tcl_SetObjResult(interp, Tcl_NewIntObj(v));
3231 break;
3232 }
3233
3234 /*
3235 ** $db timeout MILLESECONDS
3236 **
3237 ** Delay for the number of milliseconds specified when a file is locked.
3238 */
3239 case DB_TIMEOUT: {
3240 int ms;
3241 if( objc!=3 ){
3242 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
3243 return TCL_ERROR;
3244 }
3245 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
3246 sqlite3_busy_timeout(pDb->db, ms);
3247 break;
3248 }
3249
3250 /*
3251 ** $db total_changes
3252 **
3253 ** Return the number of rows that were modified, inserted, or deleted
3254 ** since the database handle was created.
3255 */
3256 case DB_TOTAL_CHANGES: {
3257 Tcl_Obj *pResult;
3258 if( objc!=2 ){
3259 Tcl_WrongNumArgs(interp, 2, objv, "");
3260 return TCL_ERROR;
3261 }
3262 pResult = Tcl_GetObjResult(interp);
3263 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
3264 break;
3265 }
3266
3267 /* $db trace ?CALLBACK?
3268 **
3269 ** Make arrangements to invoke the CALLBACK routine for each SQL statement
3270 ** that is executed. The text of the SQL is appended to CALLBACK before
3271 ** it is executed.
3272 */
3273 case DB_TRACE: {
3274 if( objc>3 ){
3275 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
3276 return TCL_ERROR;
3277 }else if( objc==2 ){
3278 if( pDb->zTrace ){
3279 Tcl_AppendResult(interp, pDb->zTrace, (char*)0);
3280 }
3281 }else{
3282 char *zTrace;
3283 int len;
3284 if( pDb->zTrace ){
3285 Tcl_Free(pDb->zTrace);
3286 }
3287 zTrace = Tcl_GetStringFromObj(objv[2], &len);
3288 if( zTrace && len>0 ){
3289 pDb->zTrace = Tcl_Alloc( len + 1 );
3290 memcpy(pDb->zTrace, zTrace, len+1);
3291 }else{
3292 pDb->zTrace = 0;
3293 }
3294 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT) && \
3295 !defined(SQLITE_OMIT_DEPRECATED)
3296 if( pDb->zTrace ){
3297 pDb->interp = interp;
3298 sqlite3_trace(pDb->db, DbTraceHandler, pDb);
3299 }else{
3300 sqlite3_trace(pDb->db, 0, 0);
3301 }
3302 #endif
3303 }
3304 break;
3305 }
3306
3307 /* $db trace_v2 ?CALLBACK? ?MASK?
3308 **
3309 ** Make arrangements to invoke the CALLBACK routine for each trace event
3310 ** matching the mask that is generated. The parameters are appended to
3311 ** CALLBACK before it is executed.
3312 */
3313 case DB_TRACE_V2: {
3314 if( objc>4 ){
3315 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK? ?MASK?");
3316 return TCL_ERROR;
3317 }else if( objc==2 ){
3318 if( pDb->zTraceV2 ){
3319 Tcl_AppendResult(interp, pDb->zTraceV2, (char*)0);
3320 }
3321 }else{
3322 char *zTraceV2;
3323 int len;
3324 Tcl_WideInt wMask = 0;
3325 if( objc==4 ){
3326 static const char *TTYPE_strs[] = {
3327 "statement", "profile", "row", "close", 0
3328 };
3329 enum TTYPE_enum {
3330 TTYPE_STMT, TTYPE_PROFILE, TTYPE_ROW, TTYPE_CLOSE
3331 };
3332 int i;
3333 if( TCL_OK!=Tcl_ListObjLength(interp, objv[3], &len) ){
3334 return TCL_ERROR;
3335 }
3336 for(i=0; i<len; i++){
3337 Tcl_Obj *pObj;
3338 int ttype;
3339 if( TCL_OK!=Tcl_ListObjIndex(interp, objv[3], i, &pObj) ){
3340 return TCL_ERROR;
3341 }
3342 if( Tcl_GetIndexFromObj(interp, pObj, TTYPE_strs, "trace type",
3343 0, &ttype)!=TCL_OK ){
3344 Tcl_WideInt wType;
3345 Tcl_Obj *pError = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
3346 Tcl_IncrRefCount(pError);
3347 if( TCL_OK==Tcl_GetWideIntFromObj(interp, pObj, &wType) ){
3348 Tcl_DecrRefCount(pError);
3349 wMask |= wType;
3350 }else{
3351 Tcl_SetObjResult(interp, pError);
3352 Tcl_DecrRefCount(pError);
3353 return TCL_ERROR;
3354 }
3355 }else{
3356 switch( (enum TTYPE_enum)ttype ){
3357 case TTYPE_STMT: wMask |= SQLITE_TRACE_STMT; break;
3358 case TTYPE_PROFILE: wMask |= SQLITE_TRACE_PROFILE; break;
3359 case TTYPE_ROW: wMask |= SQLITE_TRACE_ROW; break;
3360 case TTYPE_CLOSE: wMask |= SQLITE_TRACE_CLOSE; break;
3361 }
3362 }
3363 }
3364 }else{
3365 wMask = SQLITE_TRACE_STMT; /* use the "legacy" default */
3366 }
3367 if( pDb->zTraceV2 ){
3368 Tcl_Free(pDb->zTraceV2);
3369 }
3370 zTraceV2 = Tcl_GetStringFromObj(objv[2], &len);
3371 if( zTraceV2 && len>0 ){
3372 pDb->zTraceV2 = Tcl_Alloc( len + 1 );
3373 memcpy(pDb->zTraceV2, zTraceV2, len+1);
3374 }else{
3375 pDb->zTraceV2 = 0;
3376 }
3377 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
3378 if( pDb->zTraceV2 ){
3379 pDb->interp = interp;
3380 sqlite3_trace_v2(pDb->db, (unsigned)wMask, DbTraceV2Handler, pDb);
3381 }else{
3382 sqlite3_trace_v2(pDb->db, 0, 0, 0);
3383 }
3384 #endif
3385 }
3386 break;
3387 }
3388
3389 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT
3390 **
3391 ** Start a new transaction (if we are not already in the midst of a
3392 ** transaction) and execute the TCL script SCRIPT. After SCRIPT
3393 ** completes, either commit the transaction or roll it back if SCRIPT
3394 ** throws an exception. Or if no new transation was started, do nothing.
3395 ** pass the exception on up the stack.
3396 **
3397 ** This command was inspired by Dave Thomas's talk on Ruby at the
3398 ** 2005 O'Reilly Open Source Convention (OSCON).
3399 */
3400 case DB_TRANSACTION: {
3401 Tcl_Obj *pScript;
3402 const char *zBegin = "SAVEPOINT _tcl_transaction";
3403 if( objc!=3 && objc!=4 ){
3404 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
3405 return TCL_ERROR;
3406 }
3407
3408 if( pDb->nTransaction==0 && objc==4 ){
3409 static const char *TTYPE_strs[] = {
3410 "deferred", "exclusive", "immediate", 0
3411 };
3412 enum TTYPE_enum {
3413 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
3414 };
3415 int ttype;
3416 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
3417 0, &ttype) ){
3418 return TCL_ERROR;
3419 }
3420 switch( (enum TTYPE_enum)ttype ){
3421 case TTYPE_DEFERRED: /* no-op */; break;
3422 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break;
3423 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break;
3424 }
3425 }
3426 pScript = objv[objc-1];
3427
3428 /* Run the SQLite BEGIN command to open a transaction or savepoint. */
3429 pDb->disableAuth++;
3430 rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
3431 pDb->disableAuth--;
3432 if( rc!=SQLITE_OK ){
3433 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3434 return TCL_ERROR;
3435 }
3436 pDb->nTransaction++;
3437
3438 /* If using NRE, schedule a callback to invoke the script pScript, then
3439 ** a second callback to commit (or rollback) the transaction or savepoint
3440 ** opened above. If not using NRE, evaluate the script directly, then
3441 ** call function DbTransPostCmd() to commit (or rollback) the transaction
3442 ** or savepoint. */
3443 if( DbUseNre() ){
3444 Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0);
3445 (void)Tcl_NREvalObj(interp, pScript, 0);
3446 }else{
3447 rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0));
3448 }
3449 break;
3450 }
3451
3452 /*
3453 ** $db unlock_notify ?script?
3454 */
3455 case DB_UNLOCK_NOTIFY: {
3456 #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
3457 Tcl_AppendResult(interp, "unlock_notify not available in this build",
3458 (char*)0);
3459 rc = TCL_ERROR;
3460 #else
3461 if( objc!=2 && objc!=3 ){
3462 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
3463 rc = TCL_ERROR;
3464 }else{
3465 void (*xNotify)(void **, int) = 0;
3466 void *pNotifyArg = 0;
3467
3468 if( pDb->pUnlockNotify ){
3469 Tcl_DecrRefCount(pDb->pUnlockNotify);
3470 pDb->pUnlockNotify = 0;
3471 }
3472
3473 if( objc==3 ){
3474 xNotify = DbUnlockNotify;
3475 pNotifyArg = (void *)pDb;
3476 pDb->pUnlockNotify = objv[2];
3477 Tcl_IncrRefCount(pDb->pUnlockNotify);
3478 }
3479
3480 if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
3481 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3482 rc = TCL_ERROR;
3483 }
3484 }
3485 #endif
3486 break;
3487 }
3488
3489 /*
3490 ** $db preupdate_hook count
3491 ** $db preupdate_hook hook ?SCRIPT?
3492 ** $db preupdate_hook new INDEX
3493 ** $db preupdate_hook old INDEX
3494 */
3495 case DB_PREUPDATE: {
3496 #ifndef SQLITE_ENABLE_PREUPDATE_HOOK
3497 Tcl_AppendResult(interp, "preupdate_hook was omitted at compile-time",
3498 (char*)0);
3499 rc = TCL_ERROR;
3500 #else
3501 static const char *azSub[] = {"count", "depth", "hook", "new", "old", 0};
3502 enum DbPreupdateSubCmd {
3503 PRE_COUNT, PRE_DEPTH, PRE_HOOK, PRE_NEW, PRE_OLD
3504 };
3505 int iSub;
3506
3507 if( objc<3 ){
3508 Tcl_WrongNumArgs(interp, 2, objv, "SUB-COMMAND ?ARGS?");
3509 }
3510 if( Tcl_GetIndexFromObj(interp, objv[2], azSub, "sub-command", 0, &iSub) ){
3511 return TCL_ERROR;
3512 }
3513
3514 switch( (enum DbPreupdateSubCmd)iSub ){
3515 case PRE_COUNT: {
3516 int nCol = sqlite3_preupdate_count(pDb->db);
3517 Tcl_SetObjResult(interp, Tcl_NewIntObj(nCol));
3518 break;
3519 }
3520
3521 case PRE_HOOK: {
3522 if( objc>4 ){
3523 Tcl_WrongNumArgs(interp, 2, objv, "hook ?SCRIPT?");
3524 return TCL_ERROR;
3525 }
3526 DbHookCmd(interp, pDb, (objc==4 ? objv[3] : 0), &pDb->pPreUpdateHook);
3527 break;
3528 }
3529
3530 case PRE_DEPTH: {
3531 Tcl_Obj *pRet;
3532 if( objc!=3 ){
3533 Tcl_WrongNumArgs(interp, 3, objv, "");
3534 return TCL_ERROR;
3535 }
3536 pRet = Tcl_NewIntObj(sqlite3_preupdate_depth(pDb->db));
3537 Tcl_SetObjResult(interp, pRet);
3538 break;
3539 }
3540
3541 case PRE_NEW:
3542 case PRE_OLD: {
3543 int iIdx;
3544 sqlite3_value *pValue;
3545 if( objc!=4 ){
3546 Tcl_WrongNumArgs(interp, 3, objv, "INDEX");
3547 return TCL_ERROR;
3548 }
3549 if( Tcl_GetIntFromObj(interp, objv[3], &iIdx) ){
3550 return TCL_ERROR;
3551 }
3552
3553 if( iSub==PRE_OLD ){
3554 rc = sqlite3_preupdate_old(pDb->db, iIdx, &pValue);
3555 }else{
3556 assert( iSub==PRE_NEW );
3557 rc = sqlite3_preupdate_new(pDb->db, iIdx, &pValue);
3558 }
3559
3560 if( rc==SQLITE_OK ){
3561 Tcl_Obj *pObj;
3562 pObj = Tcl_NewStringObj((char*)sqlite3_value_text(pValue), -1);
3563 Tcl_SetObjResult(interp, pObj);
3564 }else{
3565 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), (char*)0);
3566 return TCL_ERROR;
3567 }
3568 }
3569 }
3570 #endif /* SQLITE_ENABLE_PREUPDATE_HOOK */
3571 break;
3572 }
3573
3574 /*
3575 ** $db wal_hook ?script?
3576 ** $db update_hook ?script?
3577 ** $db rollback_hook ?script?
3578 */
3579 case DB_WAL_HOOK:
3580 case DB_UPDATE_HOOK:
3581 case DB_ROLLBACK_HOOK: {
3582 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
3583 ** whether [$db update_hook] or [$db rollback_hook] was invoked.
3584 */
3585 Tcl_Obj **ppHook = 0;
3586 if( choice==DB_WAL_HOOK ) ppHook = &pDb->pWalHook;
3587 if( choice==DB_UPDATE_HOOK ) ppHook = &pDb->pUpdateHook;
3588 if( choice==DB_ROLLBACK_HOOK ) ppHook = &pDb->pRollbackHook;
3589 if( objc>3 ){
3590 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
3591 return TCL_ERROR;
3592 }
3593
3594 DbHookCmd(interp, pDb, (objc==3 ? objv[2] : 0), ppHook);
3595 break;
3596 }
3597
3598 /* $db version
3599 **
3600 ** Return the version string for this database.
3601 */
3602 case DB_VERSION: {
3603 int i;
3604 for(i=2; i<objc; i++){
3605 const char *zArg = Tcl_GetString(objv[i]);
3606 /* Optional arguments to $db version are used for testing purpose */
3607 #ifdef SQLITE_TEST
3608 /* $db version -use-legacy-prepare BOOLEAN
3609 **
3610 ** Turn the use of legacy sqlite3_prepare() on or off.
3611 */
3612 if( strcmp(zArg, "-use-legacy-prepare")==0 && i+1<objc ){
3613 i++;
3614 if( Tcl_GetBooleanFromObj(interp, objv[i], &pDb->bLegacyPrepare) ){
3615 return TCL_ERROR;
3616 }
3617 }else
3618
3619 /* $db version -last-stmt-ptr
3620 **
3621 ** Return a string which is a hex encoding of the pointer to the
3622 ** most recent sqlite3_stmt in the statement cache.
3623 */
3624 if( strcmp(zArg, "-last-stmt-ptr")==0 ){
3625 char zBuf[100];
3626 sqlite3_snprintf(sizeof(zBuf), zBuf, "%p",
3627 pDb->stmtList ? pDb->stmtList->pStmt: 0);
3628 Tcl_SetResult(interp, zBuf, TCL_VOLATILE);
3629 }else
3630 #endif /* SQLITE_TEST */
3631 {
3632 Tcl_AppendResult(interp, "unknown argument: ", zArg, (char*)0);
3633 return TCL_ERROR;
3634 }
3635 }
3636 if( i==2 ){
3637 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
3638 }
3639 break;
3640 }
3641
3642
3643 } /* End of the SWITCH statement */
3644 return rc;
3645 }
3646
3647 #if SQLITE_TCL_NRE
3648 /*
3649 ** Adaptor that provides an objCmd interface to the NRE-enabled
3650 ** interface implementation.
3651 */
DbObjCmdAdaptor(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)3652 static int SQLITE_TCLAPI DbObjCmdAdaptor(
3653 void *cd,
3654 Tcl_Interp *interp,
3655 int objc,
3656 Tcl_Obj *const*objv
3657 ){
3658 return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
3659 }
3660 #endif /* SQLITE_TCL_NRE */
3661
3662 /*
3663 ** Issue the usage message when the "sqlite3" command arguments are
3664 ** incorrect.
3665 */
sqliteCmdUsage(Tcl_Interp * interp,Tcl_Obj * const * objv)3666 static int sqliteCmdUsage(
3667 Tcl_Interp *interp,
3668 Tcl_Obj *const*objv
3669 ){
3670 Tcl_WrongNumArgs(interp, 1, objv,
3671 "HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
3672 " ?-nofollow BOOLEAN?"
3673 " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
3674 );
3675 return TCL_ERROR;
3676 }
3677
3678 /*
3679 ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
3680 ** ?-create BOOLEAN? ?-nomutex BOOLEAN?
3681 ** ?-nofollow BOOLEAN?
3682 **
3683 ** This is the main Tcl command. When the "sqlite" Tcl command is
3684 ** invoked, this routine runs to process that command.
3685 **
3686 ** The first argument, DBNAME, is an arbitrary name for a new
3687 ** database connection. This command creates a new command named
3688 ** DBNAME that is used to control that connection. The database
3689 ** connection is deleted when the DBNAME command is deleted.
3690 **
3691 ** The second argument is the name of the database file.
3692 **
3693 */
DbMain(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)3694 static int SQLITE_TCLAPI DbMain(
3695 void *cd,
3696 Tcl_Interp *interp,
3697 int objc,
3698 Tcl_Obj *const*objv
3699 ){
3700 SqliteDb *p;
3701 const char *zArg;
3702 char *zErrMsg;
3703 int i;
3704 const char *zFile = 0;
3705 const char *zVfs = 0;
3706 int flags;
3707 int bTranslateFileName = 1;
3708 Tcl_DString translatedFilename;
3709 int rc;
3710
3711 /* In normal use, each TCL interpreter runs in a single thread. So
3712 ** by default, we can turn off mutexing on SQLite database connections.
3713 ** However, for testing purposes it is useful to have mutexes turned
3714 ** on. So, by default, mutexes default off. But if compiled with
3715 ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
3716 */
3717 #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
3718 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
3719 #else
3720 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
3721 #endif
3722
3723 if( objc==1 ) return sqliteCmdUsage(interp, objv);
3724 if( objc==2 ){
3725 zArg = Tcl_GetStringFromObj(objv[1], 0);
3726 if( strcmp(zArg,"-version")==0 ){
3727 Tcl_AppendResult(interp,sqlite3_libversion(), (char*)0);
3728 return TCL_OK;
3729 }
3730 if( strcmp(zArg,"-sourceid")==0 ){
3731 Tcl_AppendResult(interp,sqlite3_sourceid(), (char*)0);
3732 return TCL_OK;
3733 }
3734 if( strcmp(zArg,"-has-codec")==0 ){
3735 Tcl_AppendResult(interp,"0",(char*)0);
3736 return TCL_OK;
3737 }
3738 if( zArg[0]=='-' ) return sqliteCmdUsage(interp, objv);
3739 }
3740 for(i=2; i<objc; i++){
3741 zArg = Tcl_GetString(objv[i]);
3742 if( zArg[0]!='-' ){
3743 if( zFile!=0 ) return sqliteCmdUsage(interp, objv);
3744 zFile = zArg;
3745 continue;
3746 }
3747 if( i==objc-1 ) return sqliteCmdUsage(interp, objv);
3748 i++;
3749 if( strcmp(zArg,"-key")==0 ){
3750 /* no-op */
3751 }else if( strcmp(zArg, "-vfs")==0 ){
3752 zVfs = Tcl_GetString(objv[i]);
3753 }else if( strcmp(zArg, "-readonly")==0 ){
3754 int b;
3755 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3756 if( b ){
3757 flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
3758 flags |= SQLITE_OPEN_READONLY;
3759 }else{
3760 flags &= ~SQLITE_OPEN_READONLY;
3761 flags |= SQLITE_OPEN_READWRITE;
3762 }
3763 }else if( strcmp(zArg, "-create")==0 ){
3764 int b;
3765 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3766 if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
3767 flags |= SQLITE_OPEN_CREATE;
3768 }else{
3769 flags &= ~SQLITE_OPEN_CREATE;
3770 }
3771 }else if( strcmp(zArg, "-nofollow")==0 ){
3772 int b;
3773 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3774 if( b ){
3775 flags |= SQLITE_OPEN_NOFOLLOW;
3776 }else{
3777 flags &= ~SQLITE_OPEN_NOFOLLOW;
3778 }
3779 }else if( strcmp(zArg, "-nomutex")==0 ){
3780 int b;
3781 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3782 if( b ){
3783 flags |= SQLITE_OPEN_NOMUTEX;
3784 flags &= ~SQLITE_OPEN_FULLMUTEX;
3785 }else{
3786 flags &= ~SQLITE_OPEN_NOMUTEX;
3787 }
3788 }else if( strcmp(zArg, "-fullmutex")==0 ){
3789 int b;
3790 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3791 if( b ){
3792 flags |= SQLITE_OPEN_FULLMUTEX;
3793 flags &= ~SQLITE_OPEN_NOMUTEX;
3794 }else{
3795 flags &= ~SQLITE_OPEN_FULLMUTEX;
3796 }
3797 }else if( strcmp(zArg, "-uri")==0 ){
3798 int b;
3799 if( Tcl_GetBooleanFromObj(interp, objv[i], &b) ) return TCL_ERROR;
3800 if( b ){
3801 flags |= SQLITE_OPEN_URI;
3802 }else{
3803 flags &= ~SQLITE_OPEN_URI;
3804 }
3805 }else if( strcmp(zArg, "-translatefilename")==0 ){
3806 if( Tcl_GetBooleanFromObj(interp, objv[i], &bTranslateFileName) ){
3807 return TCL_ERROR;
3808 }
3809 }else{
3810 Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
3811 return TCL_ERROR;
3812 }
3813 }
3814 zErrMsg = 0;
3815 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
3816 memset(p, 0, sizeof(*p));
3817 if( zFile==0 ) zFile = "";
3818 if( bTranslateFileName ){
3819 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
3820 }
3821 rc = sqlite3_open_v2(zFile, &p->db, flags, zVfs);
3822 if( bTranslateFileName ){
3823 Tcl_DStringFree(&translatedFilename);
3824 }
3825 if( p->db ){
3826 if( SQLITE_OK!=sqlite3_errcode(p->db) ){
3827 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
3828 sqlite3_close(p->db);
3829 p->db = 0;
3830 }
3831 }else{
3832 zErrMsg = sqlite3_mprintf("%s", sqlite3_errstr(rc));
3833 }
3834 if( p->db==0 ){
3835 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
3836 Tcl_Free((char*)p);
3837 sqlite3_free(zErrMsg);
3838 return TCL_ERROR;
3839 }
3840 p->maxStmt = NUM_PREPARED_STMTS;
3841 p->openFlags = flags & SQLITE_OPEN_URI;
3842 p->interp = interp;
3843 zArg = Tcl_GetStringFromObj(objv[1], 0);
3844 if( DbUseNre() ){
3845 Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
3846 (char*)p, DbDeleteCmd);
3847 }else{
3848 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
3849 }
3850 return TCL_OK;
3851 }
3852
3853 /*
3854 ** Provide a dummy Tcl_InitStubs if we are using this as a static
3855 ** library.
3856 */
3857 #ifndef USE_TCL_STUBS
3858 # undef Tcl_InitStubs
3859 # define Tcl_InitStubs(a,b,c) TCL_VERSION
3860 #endif
3861
3862 /*
3863 ** Make sure we have a PACKAGE_VERSION macro defined. This will be
3864 ** defined automatically by the TEA makefile. But other makefiles
3865 ** do not define it.
3866 */
3867 #ifndef PACKAGE_VERSION
3868 # define PACKAGE_VERSION SQLITE_VERSION
3869 #endif
3870
3871 /*
3872 ** Initialize this module.
3873 **
3874 ** This Tcl module contains only a single new Tcl command named "sqlite".
3875 ** (Hence there is no namespace. There is no point in using a namespace
3876 ** if the extension only supplies one new name!) The "sqlite" command is
3877 ** used to open a new SQLite database. See the DbMain() routine above
3878 ** for additional information.
3879 **
3880 ** The EXTERN macros are required by TCL in order to work on windows.
3881 */
Sqlite3_Init(Tcl_Interp * interp)3882 EXTERN int Sqlite3_Init(Tcl_Interp *interp){
3883 int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR;
3884 if( rc==TCL_OK ){
3885 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
3886 #ifndef SQLITE_3_SUFFIX_ONLY
3887 /* The "sqlite" alias is undocumented. It is here only to support
3888 ** legacy scripts. All new scripts should use only the "sqlite3"
3889 ** command. */
3890 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
3891 #endif
3892 rc = Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
3893 }
3894 return rc;
3895 }
Tclsqlite3_Init(Tcl_Interp * interp)3896 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
Sqlite3_Unload(Tcl_Interp * interp,int flags)3897 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Tclsqlite3_Unload(Tcl_Interp * interp,int flags)3898 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3899
3900 /* Because it accesses the file-system and uses persistent state, SQLite
3901 ** is not considered appropriate for safe interpreters. Hence, we cause
3902 ** the _SafeInit() interfaces return TCL_ERROR.
3903 */
Sqlite3_SafeInit(Tcl_Interp * interp)3904 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; }
Sqlite3_SafeUnload(Tcl_Interp * interp,int flags)3905 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;}
3906
3907
3908
3909 #ifndef SQLITE_3_SUFFIX_ONLY
Sqlite_Init(Tcl_Interp * interp)3910 int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
Tclsqlite_Init(Tcl_Interp * interp)3911 int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
Sqlite_Unload(Tcl_Interp * interp,int flags)3912 int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Tclsqlite_Unload(Tcl_Interp * interp,int flags)3913 int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
3914 #endif
3915
3916 /*
3917 ** If the TCLSH macro is defined, add code to make a stand-alone program.
3918 */
3919 #if defined(TCLSH)
3920
3921 /* This is the main routine for an ordinary TCL shell. If there are
3922 ** are arguments, run the first argument as a script. Otherwise,
3923 ** read TCL commands from standard input
3924 */
tclsh_main_loop(void)3925 static const char *tclsh_main_loop(void){
3926 static const char zMainloop[] =
3927 "if {[llength $argv]>=1} {\n"
3928 "set argv0 [lindex $argv 0]\n"
3929 "set argv [lrange $argv 1 end]\n"
3930 "source $argv0\n"
3931 "} else {\n"
3932 "set line {}\n"
3933 "while {![eof stdin]} {\n"
3934 "if {$line!=\"\"} {\n"
3935 "puts -nonewline \"> \"\n"
3936 "} else {\n"
3937 "puts -nonewline \"% \"\n"
3938 "}\n"
3939 "flush stdout\n"
3940 "append line [gets stdin]\n"
3941 "if {[info complete $line]} {\n"
3942 "if {[catch {uplevel #0 $line} result]} {\n"
3943 "puts stderr \"Error: $result\"\n"
3944 "} elseif {$result!=\"\"} {\n"
3945 "puts $result\n"
3946 "}\n"
3947 "set line {}\n"
3948 "} else {\n"
3949 "append line \\n\n"
3950 "}\n"
3951 "}\n"
3952 "}\n"
3953 ;
3954 return zMainloop;
3955 }
3956
3957 #define TCLSH_MAIN main /* Needed to fake out mktclapp */
TCLSH_MAIN(int argc,char ** argv)3958 int SQLITE_CDECL TCLSH_MAIN(int argc, char **argv){
3959 Tcl_Interp *interp;
3960 int i;
3961 const char *zScript = 0;
3962 char zArgc[32];
3963 #if defined(TCLSH_INIT_PROC)
3964 extern const char *TCLSH_INIT_PROC(Tcl_Interp*);
3965 #endif
3966
3967 #if !defined(_WIN32_WCE)
3968 if( getenv("SQLITE_DEBUG_BREAK") ){
3969 if( isatty(0) && isatty(2) ){
3970 fprintf(stderr,
3971 "attach debugger to process %d and press any key to continue.\n",
3972 GETPID());
3973 fgetc(stdin);
3974 }else{
3975 #if defined(_WIN32) || defined(WIN32)
3976 DebugBreak();
3977 #elif defined(SIGTRAP)
3978 raise(SIGTRAP);
3979 #endif
3980 }
3981 }
3982 #endif
3983
3984 /* Call sqlite3_shutdown() once before doing anything else. This is to
3985 ** test that sqlite3_shutdown() can be safely called by a process before
3986 ** sqlite3_initialize() is. */
3987 sqlite3_shutdown();
3988
3989 Tcl_FindExecutable(argv[0]);
3990 Tcl_SetSystemEncoding(NULL, "utf-8");
3991 interp = Tcl_CreateInterp();
3992 Sqlite3_Init(interp);
3993
3994 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-1);
3995 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
3996 Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
3997 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
3998 for(i=1; i<argc; i++){
3999 Tcl_SetVar(interp, "argv", argv[i],
4000 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
4001 }
4002 #if defined(TCLSH_INIT_PROC)
4003 zScript = TCLSH_INIT_PROC(interp);
4004 #endif
4005 if( zScript==0 ){
4006 zScript = tclsh_main_loop();
4007 }
4008 if( Tcl_GlobalEval(interp, zScript)!=TCL_OK ){
4009 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
4010 if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
4011 fprintf(stderr,"%s: %s\n", *argv, zInfo);
4012 return 1;
4013 }
4014 return 0;
4015 }
4016 #endif /* TCLSH */
4017