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