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