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