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