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