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