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