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