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