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