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 */ 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 */ 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 */ 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 } 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 */ 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 */ 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 */ 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 } 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 423 static void SQLITE_TCLAPI incrblobWatch( 424 ClientData instanceData, 425 int mode 426 ){ 427 /* NO-OP */ 428 } 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 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 */ 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) 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 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 */ 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 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 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 */ 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 } 4013 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 4014 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 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 */ 4021 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; } 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 */ 4032 EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp);} 4033 EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 4034 EXTERN int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 4035 EXTERN int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 4036 EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; } 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. */ 4042 EXTERN int sqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(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 */ 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 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