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