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 #include "tcl.h" 16 #include <errno.h> 17 18 /* 19 ** Some additional include files are needed if this file is not 20 ** appended to the amalgamation. 21 */ 22 #ifndef SQLITE_AMALGAMATION 23 # include "sqliteInt.h" 24 # include <stdlib.h> 25 # include <string.h> 26 # include <assert.h> 27 # include <ctype.h> 28 #endif 29 30 /* 31 * Windows needs to know which symbols to export. Unix does not. 32 * BUILD_sqlite should be undefined for Unix. 33 */ 34 #ifdef BUILD_sqlite 35 #undef TCL_STORAGE_CLASS 36 #define TCL_STORAGE_CLASS DLLEXPORT 37 #endif /* BUILD_sqlite */ 38 39 #define NUM_PREPARED_STMTS 10 40 #define MAX_PREPARED_STMTS 100 41 42 /* 43 ** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we 44 ** have to do a translation when going between the two. Set the 45 ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do 46 ** this translation. 47 */ 48 #if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8) 49 # define UTF_TRANSLATION_NEEDED 1 50 #endif 51 52 /* 53 ** New SQL functions can be created as TCL scripts. Each such function 54 ** is described by an instance of the following structure. 55 */ 56 typedef struct SqlFunc SqlFunc; 57 struct SqlFunc { 58 Tcl_Interp *interp; /* The TCL interpret to execute the function */ 59 Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */ 60 int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */ 61 char *zName; /* Name of this function */ 62 SqlFunc *pNext; /* Next function on the list of them all */ 63 }; 64 65 /* 66 ** New collation sequences function can be created as TCL scripts. Each such 67 ** function is described by an instance of the following structure. 68 */ 69 typedef struct SqlCollate SqlCollate; 70 struct SqlCollate { 71 Tcl_Interp *interp; /* The TCL interpret to execute the function */ 72 char *zScript; /* The script to be run */ 73 SqlCollate *pNext; /* Next function on the list of them all */ 74 }; 75 76 /* 77 ** Prepared statements are cached for faster execution. Each prepared 78 ** statement is described by an instance of the following structure. 79 */ 80 typedef struct SqlPreparedStmt SqlPreparedStmt; 81 struct SqlPreparedStmt { 82 SqlPreparedStmt *pNext; /* Next in linked list */ 83 SqlPreparedStmt *pPrev; /* Previous on the list */ 84 sqlite3_stmt *pStmt; /* The prepared statement */ 85 int nSql; /* chars in zSql[] */ 86 const char *zSql; /* Text of the SQL statement */ 87 }; 88 89 typedef struct IncrblobChannel IncrblobChannel; 90 91 /* 92 ** There is one instance of this structure for each SQLite database 93 ** that has been opened by the SQLite TCL interface. 94 */ 95 typedef struct SqliteDb SqliteDb; 96 struct SqliteDb { 97 sqlite3 *db; /* The "real" database structure. MUST BE FIRST */ 98 Tcl_Interp *interp; /* The interpreter used for this database */ 99 char *zBusy; /* The busy callback routine */ 100 char *zCommit; /* The commit hook callback routine */ 101 char *zTrace; /* The trace callback routine */ 102 char *zProfile; /* The profile callback routine */ 103 char *zProgress; /* The progress callback routine */ 104 char *zAuth; /* The authorization callback routine */ 105 int disableAuth; /* Disable the authorizer if it exists */ 106 char *zNull; /* Text to substitute for an SQL NULL value */ 107 SqlFunc *pFunc; /* List of SQL functions */ 108 Tcl_Obj *pUpdateHook; /* Update hook script (if any) */ 109 Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */ 110 Tcl_Obj *pUnlockNotify; /* Unlock notify script (if any) */ 111 SqlCollate *pCollate; /* List of SQL collation functions */ 112 int rc; /* Return code of most recent sqlite3_exec() */ 113 Tcl_Obj *pCollateNeeded; /* Collation needed script */ 114 SqlPreparedStmt *stmtList; /* List of prepared statements*/ 115 SqlPreparedStmt *stmtLast; /* Last statement in the list */ 116 int maxStmt; /* The next maximum number of stmtList */ 117 int nStmt; /* Number of statements in stmtList */ 118 IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */ 119 int nStep, nSort; /* Statistics for most recent operation */ 120 int nTransaction; /* Number of nested [transaction] methods */ 121 }; 122 123 struct IncrblobChannel { 124 sqlite3_blob *pBlob; /* sqlite3 blob handle */ 125 SqliteDb *pDb; /* Associated database connection */ 126 int iSeek; /* Current seek offset */ 127 Tcl_Channel channel; /* Channel identifier */ 128 IncrblobChannel *pNext; /* Linked list of all open incrblob channels */ 129 IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */ 130 }; 131 132 /* 133 ** Compute a string length that is limited to what can be stored in 134 ** lower 30 bits of a 32-bit signed integer. 135 */ 136 static int strlen30(const char *z){ 137 const char *z2 = z; 138 while( *z2 ){ z2++; } 139 return 0x3fffffff & (int)(z2 - z); 140 } 141 142 143 #ifndef SQLITE_OMIT_INCRBLOB 144 /* 145 ** Close all incrblob channels opened using database connection pDb. 146 ** This is called when shutting down the database connection. 147 */ 148 static void closeIncrblobChannels(SqliteDb *pDb){ 149 IncrblobChannel *p; 150 IncrblobChannel *pNext; 151 152 for(p=pDb->pIncrblob; p; p=pNext){ 153 pNext = p->pNext; 154 155 /* Note: Calling unregister here call Tcl_Close on the incrblob channel, 156 ** which deletes the IncrblobChannel structure at *p. So do not 157 ** call Tcl_Free() here. 158 */ 159 Tcl_UnregisterChannel(pDb->interp, p->channel); 160 } 161 } 162 163 /* 164 ** Close an incremental blob channel. 165 */ 166 static int incrblobClose(ClientData instanceData, Tcl_Interp *interp){ 167 IncrblobChannel *p = (IncrblobChannel *)instanceData; 168 int rc = sqlite3_blob_close(p->pBlob); 169 sqlite3 *db = p->pDb->db; 170 171 /* Remove the channel from the SqliteDb.pIncrblob list. */ 172 if( p->pNext ){ 173 p->pNext->pPrev = p->pPrev; 174 } 175 if( p->pPrev ){ 176 p->pPrev->pNext = p->pNext; 177 } 178 if( p->pDb->pIncrblob==p ){ 179 p->pDb->pIncrblob = p->pNext; 180 } 181 182 /* Free the IncrblobChannel structure */ 183 Tcl_Free((char *)p); 184 185 if( rc!=SQLITE_OK ){ 186 Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE); 187 return TCL_ERROR; 188 } 189 return TCL_OK; 190 } 191 192 /* 193 ** Read data from an incremental blob channel. 194 */ 195 static int incrblobInput( 196 ClientData instanceData, 197 char *buf, 198 int bufSize, 199 int *errorCodePtr 200 ){ 201 IncrblobChannel *p = (IncrblobChannel *)instanceData; 202 int nRead = bufSize; /* Number of bytes to read */ 203 int nBlob; /* Total size of the blob */ 204 int rc; /* sqlite error code */ 205 206 nBlob = sqlite3_blob_bytes(p->pBlob); 207 if( (p->iSeek+nRead)>nBlob ){ 208 nRead = nBlob-p->iSeek; 209 } 210 if( nRead<=0 ){ 211 return 0; 212 } 213 214 rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek); 215 if( rc!=SQLITE_OK ){ 216 *errorCodePtr = rc; 217 return -1; 218 } 219 220 p->iSeek += nRead; 221 return nRead; 222 } 223 224 /* 225 ** Write data to an incremental blob channel. 226 */ 227 static int incrblobOutput( 228 ClientData instanceData, 229 CONST char *buf, 230 int toWrite, 231 int *errorCodePtr 232 ){ 233 IncrblobChannel *p = (IncrblobChannel *)instanceData; 234 int nWrite = toWrite; /* Number of bytes to write */ 235 int nBlob; /* Total size of the blob */ 236 int rc; /* sqlite error code */ 237 238 nBlob = sqlite3_blob_bytes(p->pBlob); 239 if( (p->iSeek+nWrite)>nBlob ){ 240 *errorCodePtr = EINVAL; 241 return -1; 242 } 243 if( nWrite<=0 ){ 244 return 0; 245 } 246 247 rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek); 248 if( rc!=SQLITE_OK ){ 249 *errorCodePtr = EIO; 250 return -1; 251 } 252 253 p->iSeek += nWrite; 254 return nWrite; 255 } 256 257 /* 258 ** Seek an incremental blob channel. 259 */ 260 static int incrblobSeek( 261 ClientData instanceData, 262 long offset, 263 int seekMode, 264 int *errorCodePtr 265 ){ 266 IncrblobChannel *p = (IncrblobChannel *)instanceData; 267 268 switch( seekMode ){ 269 case SEEK_SET: 270 p->iSeek = offset; 271 break; 272 case SEEK_CUR: 273 p->iSeek += offset; 274 break; 275 case SEEK_END: 276 p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset; 277 break; 278 279 default: assert(!"Bad seekMode"); 280 } 281 282 return p->iSeek; 283 } 284 285 286 static void incrblobWatch(ClientData instanceData, int mode){ 287 /* NO-OP */ 288 } 289 static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){ 290 return TCL_ERROR; 291 } 292 293 static Tcl_ChannelType IncrblobChannelType = { 294 "incrblob", /* typeName */ 295 TCL_CHANNEL_VERSION_2, /* version */ 296 incrblobClose, /* closeProc */ 297 incrblobInput, /* inputProc */ 298 incrblobOutput, /* outputProc */ 299 incrblobSeek, /* seekProc */ 300 0, /* setOptionProc */ 301 0, /* getOptionProc */ 302 incrblobWatch, /* watchProc (this is a no-op) */ 303 incrblobHandle, /* getHandleProc (always returns error) */ 304 0, /* close2Proc */ 305 0, /* blockModeProc */ 306 0, /* flushProc */ 307 0, /* handlerProc */ 308 0, /* wideSeekProc */ 309 }; 310 311 /* 312 ** Create a new incrblob channel. 313 */ 314 static int createIncrblobChannel( 315 Tcl_Interp *interp, 316 SqliteDb *pDb, 317 const char *zDb, 318 const char *zTable, 319 const char *zColumn, 320 sqlite_int64 iRow, 321 int isReadonly 322 ){ 323 IncrblobChannel *p; 324 sqlite3 *db = pDb->db; 325 sqlite3_blob *pBlob; 326 int rc; 327 int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE); 328 329 /* This variable is used to name the channels: "incrblob_[incr count]" */ 330 static int count = 0; 331 char zChannel[64]; 332 333 rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob); 334 if( rc!=SQLITE_OK ){ 335 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 336 return TCL_ERROR; 337 } 338 339 p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel)); 340 p->iSeek = 0; 341 p->pBlob = pBlob; 342 343 sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count); 344 p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags); 345 Tcl_RegisterChannel(interp, p->channel); 346 347 /* Link the new channel into the SqliteDb.pIncrblob list. */ 348 p->pNext = pDb->pIncrblob; 349 p->pPrev = 0; 350 if( p->pNext ){ 351 p->pNext->pPrev = p; 352 } 353 pDb->pIncrblob = p; 354 p->pDb = pDb; 355 356 Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE); 357 return TCL_OK; 358 } 359 #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */ 360 #define closeIncrblobChannels(pDb) 361 #endif 362 363 /* 364 ** Look at the script prefix in pCmd. We will be executing this script 365 ** after first appending one or more arguments. This routine analyzes 366 ** the script to see if it is safe to use Tcl_EvalObjv() on the script 367 ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much 368 ** faster. 369 ** 370 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a 371 ** command name followed by zero or more arguments with no [...] or $ 372 ** or {...} or ; to be seen anywhere. Most callback scripts consist 373 ** of just a single procedure name and they meet this requirement. 374 */ 375 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){ 376 /* We could try to do something with Tcl_Parse(). But we will instead 377 ** just do a search for forbidden characters. If any of the forbidden 378 ** characters appear in pCmd, we will report the string as unsafe. 379 */ 380 const char *z; 381 int n; 382 z = Tcl_GetStringFromObj(pCmd, &n); 383 while( n-- > 0 ){ 384 int c = *(z++); 385 if( c=='$' || c=='[' || c==';' ) return 0; 386 } 387 return 1; 388 } 389 390 /* 391 ** Find an SqlFunc structure with the given name. Or create a new 392 ** one if an existing one cannot be found. Return a pointer to the 393 ** structure. 394 */ 395 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ 396 SqlFunc *p, *pNew; 397 int i; 398 pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen30(zName) + 1 ); 399 pNew->zName = (char*)&pNew[1]; 400 for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); } 401 pNew->zName[i] = 0; 402 for(p=pDb->pFunc; p; p=p->pNext){ 403 if( strcmp(p->zName, pNew->zName)==0 ){ 404 Tcl_Free((char*)pNew); 405 return p; 406 } 407 } 408 pNew->interp = pDb->interp; 409 pNew->pScript = 0; 410 pNew->pNext = pDb->pFunc; 411 pDb->pFunc = pNew; 412 return pNew; 413 } 414 415 /* 416 ** Finalize and free a list of prepared statements 417 */ 418 static void flushStmtCache( SqliteDb *pDb ){ 419 SqlPreparedStmt *pPreStmt; 420 421 while( pDb->stmtList ){ 422 sqlite3_finalize( pDb->stmtList->pStmt ); 423 pPreStmt = pDb->stmtList; 424 pDb->stmtList = pDb->stmtList->pNext; 425 Tcl_Free( (char*)pPreStmt ); 426 } 427 pDb->nStmt = 0; 428 pDb->stmtLast = 0; 429 } 430 431 /* 432 ** TCL calls this procedure when an sqlite3 database command is 433 ** deleted. 434 */ 435 static void DbDeleteCmd(void *db){ 436 SqliteDb *pDb = (SqliteDb*)db; 437 flushStmtCache(pDb); 438 closeIncrblobChannels(pDb); 439 sqlite3_close(pDb->db); 440 while( pDb->pFunc ){ 441 SqlFunc *pFunc = pDb->pFunc; 442 pDb->pFunc = pFunc->pNext; 443 Tcl_DecrRefCount(pFunc->pScript); 444 Tcl_Free((char*)pFunc); 445 } 446 while( pDb->pCollate ){ 447 SqlCollate *pCollate = pDb->pCollate; 448 pDb->pCollate = pCollate->pNext; 449 Tcl_Free((char*)pCollate); 450 } 451 if( pDb->zBusy ){ 452 Tcl_Free(pDb->zBusy); 453 } 454 if( pDb->zTrace ){ 455 Tcl_Free(pDb->zTrace); 456 } 457 if( pDb->zProfile ){ 458 Tcl_Free(pDb->zProfile); 459 } 460 if( pDb->zAuth ){ 461 Tcl_Free(pDb->zAuth); 462 } 463 if( pDb->zNull ){ 464 Tcl_Free(pDb->zNull); 465 } 466 if( pDb->pUpdateHook ){ 467 Tcl_DecrRefCount(pDb->pUpdateHook); 468 } 469 if( pDb->pRollbackHook ){ 470 Tcl_DecrRefCount(pDb->pRollbackHook); 471 } 472 if( pDb->pCollateNeeded ){ 473 Tcl_DecrRefCount(pDb->pCollateNeeded); 474 } 475 Tcl_Free((char*)pDb); 476 } 477 478 /* 479 ** This routine is called when a database file is locked while trying 480 ** to execute SQL. 481 */ 482 static int DbBusyHandler(void *cd, int nTries){ 483 SqliteDb *pDb = (SqliteDb*)cd; 484 int rc; 485 char zVal[30]; 486 487 sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries); 488 rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0); 489 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 490 return 0; 491 } 492 return 1; 493 } 494 495 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK 496 /* 497 ** This routine is invoked as the 'progress callback' for the database. 498 */ 499 static int DbProgressHandler(void *cd){ 500 SqliteDb *pDb = (SqliteDb*)cd; 501 int rc; 502 503 assert( pDb->zProgress ); 504 rc = Tcl_Eval(pDb->interp, pDb->zProgress); 505 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 506 return 1; 507 } 508 return 0; 509 } 510 #endif 511 512 #ifndef SQLITE_OMIT_TRACE 513 /* 514 ** This routine is called by the SQLite trace handler whenever a new 515 ** block of SQL is executed. The TCL script in pDb->zTrace is executed. 516 */ 517 static void DbTraceHandler(void *cd, const char *zSql){ 518 SqliteDb *pDb = (SqliteDb*)cd; 519 Tcl_DString str; 520 521 Tcl_DStringInit(&str); 522 Tcl_DStringAppend(&str, pDb->zTrace, -1); 523 Tcl_DStringAppendElement(&str, zSql); 524 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str)); 525 Tcl_DStringFree(&str); 526 Tcl_ResetResult(pDb->interp); 527 } 528 #endif 529 530 #ifndef SQLITE_OMIT_TRACE 531 /* 532 ** This routine is called by the SQLite profile handler after a statement 533 ** SQL has executed. The TCL script in pDb->zProfile is evaluated. 534 */ 535 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){ 536 SqliteDb *pDb = (SqliteDb*)cd; 537 Tcl_DString str; 538 char zTm[100]; 539 540 sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm); 541 Tcl_DStringInit(&str); 542 Tcl_DStringAppend(&str, pDb->zProfile, -1); 543 Tcl_DStringAppendElement(&str, zSql); 544 Tcl_DStringAppendElement(&str, zTm); 545 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str)); 546 Tcl_DStringFree(&str); 547 Tcl_ResetResult(pDb->interp); 548 } 549 #endif 550 551 /* 552 ** This routine is called when a transaction is committed. The 553 ** TCL script in pDb->zCommit is executed. If it returns non-zero or 554 ** if it throws an exception, the transaction is rolled back instead 555 ** of being committed. 556 */ 557 static int DbCommitHandler(void *cd){ 558 SqliteDb *pDb = (SqliteDb*)cd; 559 int rc; 560 561 rc = Tcl_Eval(pDb->interp, pDb->zCommit); 562 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 563 return 1; 564 } 565 return 0; 566 } 567 568 static void DbRollbackHandler(void *clientData){ 569 SqliteDb *pDb = (SqliteDb*)clientData; 570 assert(pDb->pRollbackHook); 571 if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){ 572 Tcl_BackgroundError(pDb->interp); 573 } 574 } 575 576 #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY) 577 static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){ 578 char zBuf[64]; 579 sprintf(zBuf, "%d", iArg); 580 Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY); 581 sprintf(zBuf, "%d", nArg); 582 Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY); 583 } 584 #else 585 # define setTestUnlockNotifyVars(x,y,z) 586 #endif 587 588 #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY 589 static void DbUnlockNotify(void **apArg, int nArg){ 590 int i; 591 for(i=0; i<nArg; i++){ 592 const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); 593 SqliteDb *pDb = (SqliteDb *)apArg[i]; 594 setTestUnlockNotifyVars(pDb->interp, i, nArg); 595 assert( pDb->pUnlockNotify); 596 Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags); 597 Tcl_DecrRefCount(pDb->pUnlockNotify); 598 pDb->pUnlockNotify = 0; 599 } 600 } 601 #endif 602 603 static void DbUpdateHandler( 604 void *p, 605 int op, 606 const char *zDb, 607 const char *zTbl, 608 sqlite_int64 rowid 609 ){ 610 SqliteDb *pDb = (SqliteDb *)p; 611 Tcl_Obj *pCmd; 612 613 assert( pDb->pUpdateHook ); 614 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE ); 615 616 pCmd = Tcl_DuplicateObj(pDb->pUpdateHook); 617 Tcl_IncrRefCount(pCmd); 618 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj( 619 ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1)); 620 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1)); 621 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1)); 622 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid)); 623 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT); 624 } 625 626 static void tclCollateNeeded( 627 void *pCtx, 628 sqlite3 *db, 629 int enc, 630 const char *zName 631 ){ 632 SqliteDb *pDb = (SqliteDb *)pCtx; 633 Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded); 634 Tcl_IncrRefCount(pScript); 635 Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1)); 636 Tcl_EvalObjEx(pDb->interp, pScript, 0); 637 Tcl_DecrRefCount(pScript); 638 } 639 640 /* 641 ** This routine is called to evaluate an SQL collation function implemented 642 ** using TCL script. 643 */ 644 static int tclSqlCollate( 645 void *pCtx, 646 int nA, 647 const void *zA, 648 int nB, 649 const void *zB 650 ){ 651 SqlCollate *p = (SqlCollate *)pCtx; 652 Tcl_Obj *pCmd; 653 654 pCmd = Tcl_NewStringObj(p->zScript, -1); 655 Tcl_IncrRefCount(pCmd); 656 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA)); 657 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB)); 658 Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); 659 Tcl_DecrRefCount(pCmd); 660 return (atoi(Tcl_GetStringResult(p->interp))); 661 } 662 663 /* 664 ** This routine is called to evaluate an SQL function implemented 665 ** using TCL script. 666 */ 667 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ 668 SqlFunc *p = sqlite3_user_data(context); 669 Tcl_Obj *pCmd; 670 int i; 671 int rc; 672 673 if( argc==0 ){ 674 /* If there are no arguments to the function, call Tcl_EvalObjEx on the 675 ** script object directly. This allows the TCL compiler to generate 676 ** bytecode for the command on the first invocation and thus make 677 ** subsequent invocations much faster. */ 678 pCmd = p->pScript; 679 Tcl_IncrRefCount(pCmd); 680 rc = Tcl_EvalObjEx(p->interp, pCmd, 0); 681 Tcl_DecrRefCount(pCmd); 682 }else{ 683 /* If there are arguments to the function, make a shallow copy of the 684 ** script object, lappend the arguments, then evaluate the copy. 685 ** 686 ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated. 687 ** The new Tcl_Obj contains pointers to the original list elements. 688 ** That way, when Tcl_EvalObjv() is run and shimmers the first element 689 ** of the list to tclCmdNameType, that alternate representation will 690 ** be preserved and reused on the next invocation. 691 */ 692 Tcl_Obj **aArg; 693 int nArg; 694 if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){ 695 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 696 return; 697 } 698 pCmd = Tcl_NewListObj(nArg, aArg); 699 Tcl_IncrRefCount(pCmd); 700 for(i=0; i<argc; i++){ 701 sqlite3_value *pIn = argv[i]; 702 Tcl_Obj *pVal; 703 704 /* Set pVal to contain the i'th column of this row. */ 705 switch( sqlite3_value_type(pIn) ){ 706 case SQLITE_BLOB: { 707 int bytes = sqlite3_value_bytes(pIn); 708 pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes); 709 break; 710 } 711 case SQLITE_INTEGER: { 712 sqlite_int64 v = sqlite3_value_int64(pIn); 713 if( v>=-2147483647 && v<=2147483647 ){ 714 pVal = Tcl_NewIntObj(v); 715 }else{ 716 pVal = Tcl_NewWideIntObj(v); 717 } 718 break; 719 } 720 case SQLITE_FLOAT: { 721 double r = sqlite3_value_double(pIn); 722 pVal = Tcl_NewDoubleObj(r); 723 break; 724 } 725 case SQLITE_NULL: { 726 pVal = Tcl_NewStringObj("", 0); 727 break; 728 } 729 default: { 730 int bytes = sqlite3_value_bytes(pIn); 731 pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes); 732 break; 733 } 734 } 735 rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal); 736 if( rc ){ 737 Tcl_DecrRefCount(pCmd); 738 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 739 return; 740 } 741 } 742 if( !p->useEvalObjv ){ 743 /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd 744 ** is a list without a string representation. To prevent this from 745 ** happening, make sure pCmd has a valid string representation */ 746 Tcl_GetString(pCmd); 747 } 748 rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); 749 Tcl_DecrRefCount(pCmd); 750 } 751 752 if( rc && rc!=TCL_RETURN ){ 753 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 754 }else{ 755 Tcl_Obj *pVar = Tcl_GetObjResult(p->interp); 756 int n; 757 u8 *data; 758 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 759 char c = zType[0]; 760 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ 761 /* Only return a BLOB type if the Tcl variable is a bytearray and 762 ** has no string representation. */ 763 data = Tcl_GetByteArrayFromObj(pVar, &n); 764 sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); 765 }else if( c=='b' && strcmp(zType,"boolean")==0 ){ 766 Tcl_GetIntFromObj(0, pVar, &n); 767 sqlite3_result_int(context, n); 768 }else if( c=='d' && strcmp(zType,"double")==0 ){ 769 double r; 770 Tcl_GetDoubleFromObj(0, pVar, &r); 771 sqlite3_result_double(context, r); 772 }else if( (c=='w' && strcmp(zType,"wideInt")==0) || 773 (c=='i' && strcmp(zType,"int")==0) ){ 774 Tcl_WideInt v; 775 Tcl_GetWideIntFromObj(0, pVar, &v); 776 sqlite3_result_int64(context, v); 777 }else{ 778 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 779 sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); 780 } 781 } 782 } 783 784 #ifndef SQLITE_OMIT_AUTHORIZATION 785 /* 786 ** This is the authentication function. It appends the authentication 787 ** type code and the two arguments to zCmd[] then invokes the result 788 ** on the interpreter. The reply is examined to determine if the 789 ** authentication fails or succeeds. 790 */ 791 static int auth_callback( 792 void *pArg, 793 int code, 794 const char *zArg1, 795 const char *zArg2, 796 const char *zArg3, 797 const char *zArg4 798 ){ 799 char *zCode; 800 Tcl_DString str; 801 int rc; 802 const char *zReply; 803 SqliteDb *pDb = (SqliteDb*)pArg; 804 if( pDb->disableAuth ) return SQLITE_OK; 805 806 switch( code ){ 807 case SQLITE_COPY : zCode="SQLITE_COPY"; break; 808 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break; 809 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break; 810 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break; 811 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break; 812 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break; 813 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break; 814 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break; 815 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break; 816 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break; 817 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break; 818 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break; 819 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break; 820 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break; 821 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break; 822 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break; 823 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break; 824 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break; 825 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break; 826 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break; 827 case SQLITE_READ : zCode="SQLITE_READ"; break; 828 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break; 829 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break; 830 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break; 831 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break; 832 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break; 833 case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break; 834 case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break; 835 case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break; 836 case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break; 837 case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break; 838 case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break; 839 case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break; 840 default : zCode="????"; break; 841 } 842 Tcl_DStringInit(&str); 843 Tcl_DStringAppend(&str, pDb->zAuth, -1); 844 Tcl_DStringAppendElement(&str, zCode); 845 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : ""); 846 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : ""); 847 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : ""); 848 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : ""); 849 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str)); 850 Tcl_DStringFree(&str); 851 zReply = Tcl_GetStringResult(pDb->interp); 852 if( strcmp(zReply,"SQLITE_OK")==0 ){ 853 rc = SQLITE_OK; 854 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){ 855 rc = SQLITE_DENY; 856 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){ 857 rc = SQLITE_IGNORE; 858 }else{ 859 rc = 999; 860 } 861 return rc; 862 } 863 #endif /* SQLITE_OMIT_AUTHORIZATION */ 864 865 /* 866 ** zText is a pointer to text obtained via an sqlite3_result_text() 867 ** or similar interface. This routine returns a Tcl string object, 868 ** reference count set to 0, containing the text. If a translation 869 ** between iso8859 and UTF-8 is required, it is preformed. 870 */ 871 static Tcl_Obj *dbTextToObj(char const *zText){ 872 Tcl_Obj *pVal; 873 #ifdef UTF_TRANSLATION_NEEDED 874 Tcl_DString dCol; 875 Tcl_DStringInit(&dCol); 876 Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol); 877 pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1); 878 Tcl_DStringFree(&dCol); 879 #else 880 pVal = Tcl_NewStringObj(zText, -1); 881 #endif 882 return pVal; 883 } 884 885 /* 886 ** This routine reads a line of text from FILE in, stores 887 ** the text in memory obtained from malloc() and returns a pointer 888 ** to the text. NULL is returned at end of file, or if malloc() 889 ** fails. 890 ** 891 ** The interface is like "readline" but no command-line editing 892 ** is done. 893 ** 894 ** copied from shell.c from '.import' command 895 */ 896 static char *local_getline(char *zPrompt, FILE *in){ 897 char *zLine; 898 int nLine; 899 int n; 900 int eol; 901 902 nLine = 100; 903 zLine = malloc( nLine ); 904 if( zLine==0 ) return 0; 905 n = 0; 906 eol = 0; 907 while( !eol ){ 908 if( n+100>nLine ){ 909 nLine = nLine*2 + 100; 910 zLine = realloc(zLine, nLine); 911 if( zLine==0 ) return 0; 912 } 913 if( fgets(&zLine[n], nLine - n, in)==0 ){ 914 if( n==0 ){ 915 free(zLine); 916 return 0; 917 } 918 zLine[n] = 0; 919 eol = 1; 920 break; 921 } 922 while( zLine[n] ){ n++; } 923 if( n>0 && zLine[n-1]=='\n' ){ 924 n--; 925 zLine[n] = 0; 926 eol = 1; 927 } 928 } 929 zLine = realloc( zLine, n+1 ); 930 return zLine; 931 } 932 933 934 /* 935 ** Figure out the column names for the data returned by the statement 936 ** passed as the second argument. 937 ** 938 ** If parameter papColName is not NULL, then *papColName is set to point 939 ** at an array allocated using Tcl_Alloc(). It is the callers responsibility 940 ** to free this array using Tcl_Free(), and to decrement the reference 941 ** count of each Tcl_Obj* member of the array. 942 ** 943 ** The return value of this function is the number of columns of data 944 ** returned by pStmt (and hence the size of the *papColName array). 945 ** 946 ** If pArray is not NULL, then it contains the name of a Tcl array 947 ** variable. The "*" member of this array is set to a list containing 948 ** the names of the columns returned by the statement, in order from 949 ** left to right. e.g. if the names of the returned columns are a, b and 950 ** c, it does the equivalent of the tcl command: 951 ** 952 ** set ${pArray}(*) {a b c} 953 */ 954 static int 955 computeColumnNames( 956 Tcl_Interp *interp, 957 sqlite3_stmt *pStmt, /* SQL statement */ 958 Tcl_Obj ***papColName, /* OUT: Array of column names */ 959 Tcl_Obj *pArray /* Name of array variable (may be null) */ 960 ){ 961 int nCol; 962 963 /* Compute column names */ 964 nCol = sqlite3_column_count(pStmt); 965 if( papColName ){ 966 int i; 967 Tcl_Obj **apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol ); 968 for(i=0; i<nCol; i++){ 969 apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i)); 970 Tcl_IncrRefCount(apColName[i]); 971 } 972 973 /* If results are being stored in an array variable, then create 974 ** the array(*) entry for that array 975 */ 976 if( pArray ){ 977 Tcl_Obj *pColList = Tcl_NewObj(); 978 Tcl_Obj *pStar = Tcl_NewStringObj("*", -1); 979 Tcl_IncrRefCount(pColList); 980 for(i=0; i<nCol; i++){ 981 Tcl_ListObjAppendElement(interp, pColList, apColName[i]); 982 } 983 Tcl_IncrRefCount(pStar); 984 Tcl_ObjSetVar2(interp, pArray, pStar, pColList,0); 985 Tcl_DecrRefCount(pColList); 986 Tcl_DecrRefCount(pStar); 987 } 988 *papColName = apColName; 989 } 990 991 return nCol; 992 } 993 994 /* 995 ** The "sqlite" command below creates a new Tcl command for each 996 ** connection it opens to an SQLite database. This routine is invoked 997 ** whenever one of those connection-specific commands is executed 998 ** in Tcl. For example, if you run Tcl code like this: 999 ** 1000 ** sqlite3 db1 "my_database" 1001 ** db1 close 1002 ** 1003 ** The first command opens a connection to the "my_database" database 1004 ** and calls that connection "db1". The second command causes this 1005 ** subroutine to be invoked. 1006 */ 1007 static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 1008 SqliteDb *pDb = (SqliteDb*)cd; 1009 int choice; 1010 int rc = TCL_OK; 1011 static const char *DB_strs[] = { 1012 "authorizer", "backup", "busy", 1013 "cache", "changes", "close", 1014 "collate", "collation_needed", "commit_hook", 1015 "complete", "copy", "enable_load_extension", 1016 "errorcode", "eval", "exists", 1017 "function", "incrblob", "interrupt", 1018 "last_insert_rowid", "nullvalue", "onecolumn", 1019 "profile", "progress", "rekey", 1020 "restore", "rollback_hook", "status", 1021 "timeout", "total_changes", "trace", 1022 "transaction", "unlock_notify", "update_hook", 1023 "version", 0 1024 }; 1025 enum DB_enum { 1026 DB_AUTHORIZER, DB_BACKUP, DB_BUSY, 1027 DB_CACHE, DB_CHANGES, DB_CLOSE, 1028 DB_COLLATE, DB_COLLATION_NEEDED, DB_COMMIT_HOOK, 1029 DB_COMPLETE, DB_COPY, DB_ENABLE_LOAD_EXTENSION, 1030 DB_ERRORCODE, DB_EVAL, DB_EXISTS, 1031 DB_FUNCTION, DB_INCRBLOB, DB_INTERRUPT, 1032 DB_LAST_INSERT_ROWID, DB_NULLVALUE, DB_ONECOLUMN, 1033 DB_PROFILE, DB_PROGRESS, DB_REKEY, 1034 DB_RESTORE, DB_ROLLBACK_HOOK, DB_STATUS, 1035 DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE, 1036 DB_TRANSACTION, DB_UNLOCK_NOTIFY, DB_UPDATE_HOOK, 1037 DB_VERSION, 1038 }; 1039 /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */ 1040 1041 if( objc<2 ){ 1042 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ..."); 1043 return TCL_ERROR; 1044 } 1045 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){ 1046 return TCL_ERROR; 1047 } 1048 1049 switch( (enum DB_enum)choice ){ 1050 1051 /* $db authorizer ?CALLBACK? 1052 ** 1053 ** Invoke the given callback to authorize each SQL operation as it is 1054 ** compiled. 5 arguments are appended to the callback before it is 1055 ** invoked: 1056 ** 1057 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...) 1058 ** (2) First descriptive name (depends on authorization type) 1059 ** (3) Second descriptive name 1060 ** (4) Name of the database (ex: "main", "temp") 1061 ** (5) Name of trigger that is doing the access 1062 ** 1063 ** The callback should return on of the following strings: SQLITE_OK, 1064 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error. 1065 ** 1066 ** If this method is invoked with no arguments, the current authorization 1067 ** callback string is returned. 1068 */ 1069 case DB_AUTHORIZER: { 1070 #ifdef SQLITE_OMIT_AUTHORIZATION 1071 Tcl_AppendResult(interp, "authorization not available in this build", 0); 1072 return TCL_ERROR; 1073 #else 1074 if( objc>3 ){ 1075 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 1076 return TCL_ERROR; 1077 }else if( objc==2 ){ 1078 if( pDb->zAuth ){ 1079 Tcl_AppendResult(interp, pDb->zAuth, 0); 1080 } 1081 }else{ 1082 char *zAuth; 1083 int len; 1084 if( pDb->zAuth ){ 1085 Tcl_Free(pDb->zAuth); 1086 } 1087 zAuth = Tcl_GetStringFromObj(objv[2], &len); 1088 if( zAuth && len>0 ){ 1089 pDb->zAuth = Tcl_Alloc( len + 1 ); 1090 memcpy(pDb->zAuth, zAuth, len+1); 1091 }else{ 1092 pDb->zAuth = 0; 1093 } 1094 if( pDb->zAuth ){ 1095 pDb->interp = interp; 1096 sqlite3_set_authorizer(pDb->db, auth_callback, pDb); 1097 }else{ 1098 sqlite3_set_authorizer(pDb->db, 0, 0); 1099 } 1100 } 1101 #endif 1102 break; 1103 } 1104 1105 /* $db backup ?DATABASE? FILENAME 1106 ** 1107 ** Open or create a database file named FILENAME. Transfer the 1108 ** content of local database DATABASE (default: "main") into the 1109 ** FILENAME database. 1110 */ 1111 case DB_BACKUP: { 1112 const char *zDestFile; 1113 const char *zSrcDb; 1114 sqlite3 *pDest; 1115 sqlite3_backup *pBackup; 1116 1117 if( objc==3 ){ 1118 zSrcDb = "main"; 1119 zDestFile = Tcl_GetString(objv[2]); 1120 }else if( objc==4 ){ 1121 zSrcDb = Tcl_GetString(objv[2]); 1122 zDestFile = Tcl_GetString(objv[3]); 1123 }else{ 1124 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); 1125 return TCL_ERROR; 1126 } 1127 rc = sqlite3_open(zDestFile, &pDest); 1128 if( rc!=SQLITE_OK ){ 1129 Tcl_AppendResult(interp, "cannot open target database: ", 1130 sqlite3_errmsg(pDest), (char*)0); 1131 sqlite3_close(pDest); 1132 return TCL_ERROR; 1133 } 1134 pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb); 1135 if( pBackup==0 ){ 1136 Tcl_AppendResult(interp, "backup failed: ", 1137 sqlite3_errmsg(pDest), (char*)0); 1138 sqlite3_close(pDest); 1139 return TCL_ERROR; 1140 } 1141 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){} 1142 sqlite3_backup_finish(pBackup); 1143 if( rc==SQLITE_DONE ){ 1144 rc = TCL_OK; 1145 }else{ 1146 Tcl_AppendResult(interp, "backup failed: ", 1147 sqlite3_errmsg(pDest), (char*)0); 1148 rc = TCL_ERROR; 1149 } 1150 sqlite3_close(pDest); 1151 break; 1152 } 1153 1154 /* $db busy ?CALLBACK? 1155 ** 1156 ** Invoke the given callback if an SQL statement attempts to open 1157 ** a locked database file. 1158 */ 1159 case DB_BUSY: { 1160 if( objc>3 ){ 1161 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK"); 1162 return TCL_ERROR; 1163 }else if( objc==2 ){ 1164 if( pDb->zBusy ){ 1165 Tcl_AppendResult(interp, pDb->zBusy, 0); 1166 } 1167 }else{ 1168 char *zBusy; 1169 int len; 1170 if( pDb->zBusy ){ 1171 Tcl_Free(pDb->zBusy); 1172 } 1173 zBusy = Tcl_GetStringFromObj(objv[2], &len); 1174 if( zBusy && len>0 ){ 1175 pDb->zBusy = Tcl_Alloc( len + 1 ); 1176 memcpy(pDb->zBusy, zBusy, len+1); 1177 }else{ 1178 pDb->zBusy = 0; 1179 } 1180 if( pDb->zBusy ){ 1181 pDb->interp = interp; 1182 sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb); 1183 }else{ 1184 sqlite3_busy_handler(pDb->db, 0, 0); 1185 } 1186 } 1187 break; 1188 } 1189 1190 /* $db cache flush 1191 ** $db cache size n 1192 ** 1193 ** Flush the prepared statement cache, or set the maximum number of 1194 ** cached statements. 1195 */ 1196 case DB_CACHE: { 1197 char *subCmd; 1198 int n; 1199 1200 if( objc<=2 ){ 1201 Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?"); 1202 return TCL_ERROR; 1203 } 1204 subCmd = Tcl_GetStringFromObj( objv[2], 0 ); 1205 if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){ 1206 if( objc!=3 ){ 1207 Tcl_WrongNumArgs(interp, 2, objv, "flush"); 1208 return TCL_ERROR; 1209 }else{ 1210 flushStmtCache( pDb ); 1211 } 1212 }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){ 1213 if( objc!=4 ){ 1214 Tcl_WrongNumArgs(interp, 2, objv, "size n"); 1215 return TCL_ERROR; 1216 }else{ 1217 if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){ 1218 Tcl_AppendResult( interp, "cannot convert \"", 1219 Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0); 1220 return TCL_ERROR; 1221 }else{ 1222 if( n<0 ){ 1223 flushStmtCache( pDb ); 1224 n = 0; 1225 }else if( n>MAX_PREPARED_STMTS ){ 1226 n = MAX_PREPARED_STMTS; 1227 } 1228 pDb->maxStmt = n; 1229 } 1230 } 1231 }else{ 1232 Tcl_AppendResult( interp, "bad option \"", 1233 Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size", 0); 1234 return TCL_ERROR; 1235 } 1236 break; 1237 } 1238 1239 /* $db changes 1240 ** 1241 ** Return the number of rows that were modified, inserted, or deleted by 1242 ** the most recent INSERT, UPDATE or DELETE statement, not including 1243 ** any changes made by trigger programs. 1244 */ 1245 case DB_CHANGES: { 1246 Tcl_Obj *pResult; 1247 if( objc!=2 ){ 1248 Tcl_WrongNumArgs(interp, 2, objv, ""); 1249 return TCL_ERROR; 1250 } 1251 pResult = Tcl_GetObjResult(interp); 1252 Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db)); 1253 break; 1254 } 1255 1256 /* $db close 1257 ** 1258 ** Shutdown the database 1259 */ 1260 case DB_CLOSE: { 1261 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0)); 1262 break; 1263 } 1264 1265 /* 1266 ** $db collate NAME SCRIPT 1267 ** 1268 ** Create a new SQL collation function called NAME. Whenever 1269 ** that function is called, invoke SCRIPT to evaluate the function. 1270 */ 1271 case DB_COLLATE: { 1272 SqlCollate *pCollate; 1273 char *zName; 1274 char *zScript; 1275 int nScript; 1276 if( objc!=4 ){ 1277 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); 1278 return TCL_ERROR; 1279 } 1280 zName = Tcl_GetStringFromObj(objv[2], 0); 1281 zScript = Tcl_GetStringFromObj(objv[3], &nScript); 1282 pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 ); 1283 if( pCollate==0 ) return TCL_ERROR; 1284 pCollate->interp = interp; 1285 pCollate->pNext = pDb->pCollate; 1286 pCollate->zScript = (char*)&pCollate[1]; 1287 pDb->pCollate = pCollate; 1288 memcpy(pCollate->zScript, zScript, nScript+1); 1289 if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, 1290 pCollate, tclSqlCollate) ){ 1291 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 1292 return TCL_ERROR; 1293 } 1294 break; 1295 } 1296 1297 /* 1298 ** $db collation_needed SCRIPT 1299 ** 1300 ** Create a new SQL collation function called NAME. Whenever 1301 ** that function is called, invoke SCRIPT to evaluate the function. 1302 */ 1303 case DB_COLLATION_NEEDED: { 1304 if( objc!=3 ){ 1305 Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT"); 1306 return TCL_ERROR; 1307 } 1308 if( pDb->pCollateNeeded ){ 1309 Tcl_DecrRefCount(pDb->pCollateNeeded); 1310 } 1311 pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]); 1312 Tcl_IncrRefCount(pDb->pCollateNeeded); 1313 sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded); 1314 break; 1315 } 1316 1317 /* $db commit_hook ?CALLBACK? 1318 ** 1319 ** Invoke the given callback just before committing every SQL transaction. 1320 ** If the callback throws an exception or returns non-zero, then the 1321 ** transaction is aborted. If CALLBACK is an empty string, the callback 1322 ** is disabled. 1323 */ 1324 case DB_COMMIT_HOOK: { 1325 if( objc>3 ){ 1326 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 1327 return TCL_ERROR; 1328 }else if( objc==2 ){ 1329 if( pDb->zCommit ){ 1330 Tcl_AppendResult(interp, pDb->zCommit, 0); 1331 } 1332 }else{ 1333 char *zCommit; 1334 int len; 1335 if( pDb->zCommit ){ 1336 Tcl_Free(pDb->zCommit); 1337 } 1338 zCommit = Tcl_GetStringFromObj(objv[2], &len); 1339 if( zCommit && len>0 ){ 1340 pDb->zCommit = Tcl_Alloc( len + 1 ); 1341 memcpy(pDb->zCommit, zCommit, len+1); 1342 }else{ 1343 pDb->zCommit = 0; 1344 } 1345 if( pDb->zCommit ){ 1346 pDb->interp = interp; 1347 sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb); 1348 }else{ 1349 sqlite3_commit_hook(pDb->db, 0, 0); 1350 } 1351 } 1352 break; 1353 } 1354 1355 /* $db complete SQL 1356 ** 1357 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if 1358 ** additional lines of input are needed. This is similar to the 1359 ** built-in "info complete" command of Tcl. 1360 */ 1361 case DB_COMPLETE: { 1362 #ifndef SQLITE_OMIT_COMPLETE 1363 Tcl_Obj *pResult; 1364 int isComplete; 1365 if( objc!=3 ){ 1366 Tcl_WrongNumArgs(interp, 2, objv, "SQL"); 1367 return TCL_ERROR; 1368 } 1369 isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) ); 1370 pResult = Tcl_GetObjResult(interp); 1371 Tcl_SetBooleanObj(pResult, isComplete); 1372 #endif 1373 break; 1374 } 1375 1376 /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR? 1377 ** 1378 ** Copy data into table from filename, optionally using SEPARATOR 1379 ** as column separators. If a column contains a null string, or the 1380 ** value of NULLINDICATOR, a NULL is inserted for the column. 1381 ** conflict-algorithm is one of the sqlite conflict algorithms: 1382 ** rollback, abort, fail, ignore, replace 1383 ** On success, return the number of lines processed, not necessarily same 1384 ** as 'db changes' due to conflict-algorithm selected. 1385 ** 1386 ** This code is basically an implementation/enhancement of 1387 ** the sqlite3 shell.c ".import" command. 1388 ** 1389 ** This command usage is equivalent to the sqlite2.x COPY statement, 1390 ** which imports file data into a table using the PostgreSQL COPY file format: 1391 ** $db copy $conflit_algo $table_name $filename \t \\N 1392 */ 1393 case DB_COPY: { 1394 char *zTable; /* Insert data into this table */ 1395 char *zFile; /* The file from which to extract data */ 1396 char *zConflict; /* The conflict algorithm to use */ 1397 sqlite3_stmt *pStmt; /* A statement */ 1398 int nCol; /* Number of columns in the table */ 1399 int nByte; /* Number of bytes in an SQL string */ 1400 int i, j; /* Loop counters */ 1401 int nSep; /* Number of bytes in zSep[] */ 1402 int nNull; /* Number of bytes in zNull[] */ 1403 char *zSql; /* An SQL statement */ 1404 char *zLine; /* A single line of input from the file */ 1405 char **azCol; /* zLine[] broken up into columns */ 1406 char *zCommit; /* How to commit changes */ 1407 FILE *in; /* The input file */ 1408 int lineno = 0; /* Line number of input file */ 1409 char zLineNum[80]; /* Line number print buffer */ 1410 Tcl_Obj *pResult; /* interp result */ 1411 1412 char *zSep; 1413 char *zNull; 1414 if( objc<5 || objc>7 ){ 1415 Tcl_WrongNumArgs(interp, 2, objv, 1416 "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"); 1417 return TCL_ERROR; 1418 } 1419 if( objc>=6 ){ 1420 zSep = Tcl_GetStringFromObj(objv[5], 0); 1421 }else{ 1422 zSep = "\t"; 1423 } 1424 if( objc>=7 ){ 1425 zNull = Tcl_GetStringFromObj(objv[6], 0); 1426 }else{ 1427 zNull = ""; 1428 } 1429 zConflict = Tcl_GetStringFromObj(objv[2], 0); 1430 zTable = Tcl_GetStringFromObj(objv[3], 0); 1431 zFile = Tcl_GetStringFromObj(objv[4], 0); 1432 nSep = strlen30(zSep); 1433 nNull = strlen30(zNull); 1434 if( nSep==0 ){ 1435 Tcl_AppendResult(interp,"Error: non-null separator required for copy",0); 1436 return TCL_ERROR; 1437 } 1438 if(strcmp(zConflict, "rollback") != 0 && 1439 strcmp(zConflict, "abort" ) != 0 && 1440 strcmp(zConflict, "fail" ) != 0 && 1441 strcmp(zConflict, "ignore" ) != 0 && 1442 strcmp(zConflict, "replace" ) != 0 ) { 1443 Tcl_AppendResult(interp, "Error: \"", zConflict, 1444 "\", conflict-algorithm must be one of: rollback, " 1445 "abort, fail, ignore, or replace", 0); 1446 return TCL_ERROR; 1447 } 1448 zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable); 1449 if( zSql==0 ){ 1450 Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0); 1451 return TCL_ERROR; 1452 } 1453 nByte = strlen30(zSql); 1454 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); 1455 sqlite3_free(zSql); 1456 if( rc ){ 1457 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); 1458 nCol = 0; 1459 }else{ 1460 nCol = sqlite3_column_count(pStmt); 1461 } 1462 sqlite3_finalize(pStmt); 1463 if( nCol==0 ) { 1464 return TCL_ERROR; 1465 } 1466 zSql = malloc( nByte + 50 + nCol*2 ); 1467 if( zSql==0 ) { 1468 Tcl_AppendResult(interp, "Error: can't malloc()", 0); 1469 return TCL_ERROR; 1470 } 1471 sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?", 1472 zConflict, zTable); 1473 j = strlen30(zSql); 1474 for(i=1; i<nCol; i++){ 1475 zSql[j++] = ','; 1476 zSql[j++] = '?'; 1477 } 1478 zSql[j++] = ')'; 1479 zSql[j] = 0; 1480 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); 1481 free(zSql); 1482 if( rc ){ 1483 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); 1484 sqlite3_finalize(pStmt); 1485 return TCL_ERROR; 1486 } 1487 in = fopen(zFile, "rb"); 1488 if( in==0 ){ 1489 Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL); 1490 sqlite3_finalize(pStmt); 1491 return TCL_ERROR; 1492 } 1493 azCol = malloc( sizeof(azCol[0])*(nCol+1) ); 1494 if( azCol==0 ) { 1495 Tcl_AppendResult(interp, "Error: can't malloc()", 0); 1496 fclose(in); 1497 return TCL_ERROR; 1498 } 1499 (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); 1500 zCommit = "COMMIT"; 1501 while( (zLine = local_getline(0, in))!=0 ){ 1502 char *z; 1503 i = 0; 1504 lineno++; 1505 azCol[0] = zLine; 1506 for(i=0, z=zLine; *z; z++){ 1507 if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ 1508 *z = 0; 1509 i++; 1510 if( i<nCol ){ 1511 azCol[i] = &z[nSep]; 1512 z += nSep-1; 1513 } 1514 } 1515 } 1516 if( i+1!=nCol ){ 1517 char *zErr; 1518 int nErr = strlen30(zFile) + 200; 1519 zErr = malloc(nErr); 1520 if( zErr ){ 1521 sqlite3_snprintf(nErr, zErr, 1522 "Error: %s line %d: expected %d columns of data but found %d", 1523 zFile, lineno, nCol, i+1); 1524 Tcl_AppendResult(interp, zErr, 0); 1525 free(zErr); 1526 } 1527 zCommit = "ROLLBACK"; 1528 break; 1529 } 1530 for(i=0; i<nCol; i++){ 1531 /* check for null data, if so, bind as null */ 1532 if( (nNull>0 && strcmp(azCol[i], zNull)==0) 1533 || strlen30(azCol[i])==0 1534 ){ 1535 sqlite3_bind_null(pStmt, i+1); 1536 }else{ 1537 sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC); 1538 } 1539 } 1540 sqlite3_step(pStmt); 1541 rc = sqlite3_reset(pStmt); 1542 free(zLine); 1543 if( rc!=SQLITE_OK ){ 1544 Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0); 1545 zCommit = "ROLLBACK"; 1546 break; 1547 } 1548 } 1549 free(azCol); 1550 fclose(in); 1551 sqlite3_finalize(pStmt); 1552 (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); 1553 1554 if( zCommit[0] == 'C' ){ 1555 /* success, set result as number of lines processed */ 1556 pResult = Tcl_GetObjResult(interp); 1557 Tcl_SetIntObj(pResult, lineno); 1558 rc = TCL_OK; 1559 }else{ 1560 /* failure, append lineno where failed */ 1561 sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno); 1562 Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0); 1563 rc = TCL_ERROR; 1564 } 1565 break; 1566 } 1567 1568 /* 1569 ** $db enable_load_extension BOOLEAN 1570 ** 1571 ** Turn the extension loading feature on or off. It if off by 1572 ** default. 1573 */ 1574 case DB_ENABLE_LOAD_EXTENSION: { 1575 #ifndef SQLITE_OMIT_LOAD_EXTENSION 1576 int onoff; 1577 if( objc!=3 ){ 1578 Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN"); 1579 return TCL_ERROR; 1580 } 1581 if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){ 1582 return TCL_ERROR; 1583 } 1584 sqlite3_enable_load_extension(pDb->db, onoff); 1585 break; 1586 #else 1587 Tcl_AppendResult(interp, "extension loading is turned off at compile-time", 1588 0); 1589 return TCL_ERROR; 1590 #endif 1591 } 1592 1593 /* 1594 ** $db errorcode 1595 ** 1596 ** Return the numeric error code that was returned by the most recent 1597 ** call to sqlite3_exec(). 1598 */ 1599 case DB_ERRORCODE: { 1600 Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db))); 1601 break; 1602 } 1603 1604 /* 1605 ** $db eval $sql ?array? ?{ ...code... }? 1606 ** $db onecolumn $sql 1607 ** 1608 ** The SQL statement in $sql is evaluated. For each row, the values are 1609 ** placed in elements of the array named "array" and ...code... is executed. 1610 ** If "array" and "code" are omitted, then no callback is every invoked. 1611 ** If "array" is an empty string, then the values are placed in variables 1612 ** that have the same name as the fields extracted by the query. 1613 ** 1614 ** The onecolumn method is the equivalent of: 1615 ** lindex [$db eval $sql] 0 1616 */ 1617 case DB_ONECOLUMN: 1618 case DB_EVAL: 1619 case DB_EXISTS: { 1620 char const *zSql; /* Next SQL statement to execute */ 1621 char const *zLeft; /* What is left after first stmt in zSql */ 1622 sqlite3_stmt *pStmt; /* Compiled SQL statment */ 1623 Tcl_Obj *pArray; /* Name of array into which results are written */ 1624 Tcl_Obj *pScript; /* Script to run for each result set */ 1625 Tcl_Obj **apParm; /* Parameters that need a Tcl_DecrRefCount() */ 1626 int nParm; /* Number of entries used in apParm[] */ 1627 Tcl_Obj *aParm[10]; /* Static space for apParm[] in the common case */ 1628 Tcl_Obj *pRet; /* Value to be returned */ 1629 SqlPreparedStmt *pPreStmt; /* Pointer to a prepared statement */ 1630 int rc2; 1631 1632 if( choice==DB_EVAL ){ 1633 if( objc<3 || objc>5 ){ 1634 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); 1635 return TCL_ERROR; 1636 } 1637 pRet = Tcl_NewObj(); 1638 Tcl_IncrRefCount(pRet); 1639 }else{ 1640 if( objc!=3 ){ 1641 Tcl_WrongNumArgs(interp, 2, objv, "SQL"); 1642 return TCL_ERROR; 1643 } 1644 if( choice==DB_EXISTS ){ 1645 pRet = Tcl_NewBooleanObj(0); 1646 Tcl_IncrRefCount(pRet); 1647 }else{ 1648 pRet = 0; 1649 } 1650 } 1651 if( objc==3 ){ 1652 pArray = pScript = 0; 1653 }else if( objc==4 ){ 1654 pArray = 0; 1655 pScript = objv[3]; 1656 }else{ 1657 pArray = objv[3]; 1658 if( Tcl_GetString(pArray)[0]==0 ) pArray = 0; 1659 pScript = objv[4]; 1660 } 1661 1662 Tcl_IncrRefCount(objv[2]); 1663 zSql = Tcl_GetStringFromObj(objv[2], 0); 1664 while( rc==TCL_OK && zSql[0] ){ 1665 int i; /* Loop counter */ 1666 int nVar; /* Number of bind parameters in the pStmt */ 1667 int nCol = -1; /* Number of columns in the result set */ 1668 Tcl_Obj **apColName = 0; /* Array of column names */ 1669 int len; /* String length of zSql */ 1670 1671 /* Try to find a SQL statement that has already been compiled and 1672 ** which matches the next sequence of SQL. 1673 */ 1674 pStmt = 0; 1675 while( isspace(zSql[0]) ){ zSql++; } 1676 len = strlen30(zSql); 1677 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){ 1678 int n = pPreStmt->nSql; 1679 if( len>=n 1680 && memcmp(pPreStmt->zSql, zSql, n)==0 1681 && (zSql[n]==0 || zSql[n-1]==';') 1682 ){ 1683 pStmt = pPreStmt->pStmt; 1684 zLeft = &zSql[pPreStmt->nSql]; 1685 1686 /* When a prepared statement is found, unlink it from the 1687 ** cache list. It will later be added back to the beginning 1688 ** of the cache list in order to implement LRU replacement. 1689 */ 1690 if( pPreStmt->pPrev ){ 1691 pPreStmt->pPrev->pNext = pPreStmt->pNext; 1692 }else{ 1693 pDb->stmtList = pPreStmt->pNext; 1694 } 1695 if( pPreStmt->pNext ){ 1696 pPreStmt->pNext->pPrev = pPreStmt->pPrev; 1697 }else{ 1698 pDb->stmtLast = pPreStmt->pPrev; 1699 } 1700 pDb->nStmt--; 1701 break; 1702 } 1703 } 1704 1705 /* If no prepared statement was found. Compile the SQL text 1706 */ 1707 if( pStmt==0 ){ 1708 if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, &zLeft) ){ 1709 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1710 rc = TCL_ERROR; 1711 break; 1712 } 1713 if( pStmt==0 ){ 1714 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ 1715 /* A compile-time error in the statement 1716 */ 1717 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1718 rc = TCL_ERROR; 1719 break; 1720 }else{ 1721 /* The statement was a no-op. Continue to the next statement 1722 ** in the SQL string. 1723 */ 1724 zSql = zLeft; 1725 continue; 1726 } 1727 } 1728 assert( pPreStmt==0 ); 1729 } 1730 1731 /* Bind values to parameters that begin with $ or : 1732 */ 1733 nVar = sqlite3_bind_parameter_count(pStmt); 1734 nParm = 0; 1735 if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){ 1736 apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0])); 1737 }else{ 1738 apParm = aParm; 1739 } 1740 for(i=1; i<=nVar; i++){ 1741 const char *zVar = sqlite3_bind_parameter_name(pStmt, i); 1742 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){ 1743 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0); 1744 if( pVar ){ 1745 int n; 1746 u8 *data; 1747 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 1748 char c = zType[0]; 1749 if( zVar[0]=='@' || 1750 (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){ 1751 /* Load a BLOB type if the Tcl variable is a bytearray and 1752 ** it has no string representation or the host 1753 ** parameter name begins with "@". */ 1754 data = Tcl_GetByteArrayFromObj(pVar, &n); 1755 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); 1756 Tcl_IncrRefCount(pVar); 1757 apParm[nParm++] = pVar; 1758 }else if( c=='b' && strcmp(zType,"boolean")==0 ){ 1759 Tcl_GetIntFromObj(interp, pVar, &n); 1760 sqlite3_bind_int(pStmt, i, n); 1761 }else if( c=='d' && strcmp(zType,"double")==0 ){ 1762 double r; 1763 Tcl_GetDoubleFromObj(interp, pVar, &r); 1764 sqlite3_bind_double(pStmt, i, r); 1765 }else if( (c=='w' && strcmp(zType,"wideInt")==0) || 1766 (c=='i' && strcmp(zType,"int")==0) ){ 1767 Tcl_WideInt v; 1768 Tcl_GetWideIntFromObj(interp, pVar, &v); 1769 sqlite3_bind_int64(pStmt, i, v); 1770 }else{ 1771 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 1772 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); 1773 Tcl_IncrRefCount(pVar); 1774 apParm[nParm++] = pVar; 1775 } 1776 }else{ 1777 sqlite3_bind_null( pStmt, i ); 1778 } 1779 } 1780 } 1781 1782 /* Execute the SQL 1783 */ 1784 while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){ 1785 1786 /* Compute column names. This must be done after the first successful 1787 ** call to sqlite3_step(), in case the query is recompiled and the 1788 ** number or names of the returned columns changes. 1789 */ 1790 assert(!pArray||pScript); 1791 if (nCol < 0) { 1792 Tcl_Obj ***ap = (pScript?&apColName:0); 1793 nCol = computeColumnNames(interp, pStmt, ap, pArray); 1794 } 1795 1796 for(i=0; i<nCol; i++){ 1797 Tcl_Obj *pVal; 1798 1799 /* Set pVal to contain the i'th column of this row. */ 1800 switch( sqlite3_column_type(pStmt, i) ){ 1801 case SQLITE_BLOB: { 1802 int bytes = sqlite3_column_bytes(pStmt, i); 1803 const char *zBlob = sqlite3_column_blob(pStmt, i); 1804 if( !zBlob ) bytes = 0; 1805 pVal = Tcl_NewByteArrayObj((u8*)zBlob, bytes); 1806 break; 1807 } 1808 case SQLITE_INTEGER: { 1809 sqlite_int64 v = sqlite3_column_int64(pStmt, i); 1810 if( v>=-2147483647 && v<=2147483647 ){ 1811 pVal = Tcl_NewIntObj(v); 1812 }else{ 1813 pVal = Tcl_NewWideIntObj(v); 1814 } 1815 break; 1816 } 1817 case SQLITE_FLOAT: { 1818 double r = sqlite3_column_double(pStmt, i); 1819 pVal = Tcl_NewDoubleObj(r); 1820 break; 1821 } 1822 case SQLITE_NULL: { 1823 pVal = dbTextToObj(pDb->zNull); 1824 break; 1825 } 1826 default: { 1827 pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i)); 1828 break; 1829 } 1830 } 1831 1832 if( pScript ){ 1833 if( pArray==0 ){ 1834 Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); 1835 }else{ 1836 Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); 1837 } 1838 }else if( choice==DB_ONECOLUMN ){ 1839 assert( pRet==0 ); 1840 if( pRet==0 ){ 1841 pRet = pVal; 1842 Tcl_IncrRefCount(pRet); 1843 } 1844 rc = TCL_BREAK; 1845 i = nCol; 1846 }else if( choice==DB_EXISTS ){ 1847 Tcl_DecrRefCount(pRet); 1848 pRet = Tcl_NewBooleanObj(1); 1849 Tcl_IncrRefCount(pRet); 1850 rc = TCL_BREAK; 1851 i = nCol; 1852 }else{ 1853 Tcl_ListObjAppendElement(interp, pRet, pVal); 1854 } 1855 } 1856 1857 if( pScript ){ 1858 pDb->nStep = sqlite3_stmt_status(pStmt, 1859 SQLITE_STMTSTATUS_FULLSCAN_STEP, 0); 1860 pDb->nSort = sqlite3_stmt_status(pStmt, 1861 SQLITE_STMTSTATUS_SORT, 0); 1862 rc = Tcl_EvalObjEx(interp, pScript, 0); 1863 if( rc==TCL_CONTINUE ){ 1864 rc = TCL_OK; 1865 } 1866 } 1867 } 1868 if( rc==TCL_BREAK ){ 1869 rc = TCL_OK; 1870 } 1871 1872 /* Free the column name objects */ 1873 if( pScript ){ 1874 /* If the query returned no rows, but an array variable was 1875 ** specified, call computeColumnNames() now to populate the 1876 ** arrayname(*) variable. 1877 */ 1878 if (pArray && nCol < 0) { 1879 Tcl_Obj ***ap = (pScript?&apColName:0); 1880 nCol = computeColumnNames(interp, pStmt, ap, pArray); 1881 } 1882 for(i=0; i<nCol; i++){ 1883 Tcl_DecrRefCount(apColName[i]); 1884 } 1885 Tcl_Free((char*)apColName); 1886 } 1887 1888 /* Free the bound string and blob parameters */ 1889 for(i=0; i<nParm; i++){ 1890 Tcl_DecrRefCount(apParm[i]); 1891 } 1892 if( apParm!=aParm ){ 1893 Tcl_Free((char*)apParm); 1894 } 1895 1896 /* Reset the statement. If the result code is SQLITE_SCHEMA, then 1897 ** flush the statement cache and try the statement again. 1898 */ 1899 rc2 = sqlite3_reset(pStmt); 1900 pDb->nStep = sqlite3_stmt_status(pStmt, 1901 SQLITE_STMTSTATUS_FULLSCAN_STEP, 1); 1902 pDb->nSort = sqlite3_stmt_status(pStmt, 1903 SQLITE_STMTSTATUS_SORT, 1); 1904 if( SQLITE_OK!=rc2 ){ 1905 /* If a run-time error occurs, report the error and stop reading 1906 ** the SQL 1907 */ 1908 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1909 sqlite3_finalize(pStmt); 1910 rc = TCL_ERROR; 1911 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1912 break; 1913 }else if( pDb->maxStmt<=0 ){ 1914 /* If the cache is turned off, deallocated the statement */ 1915 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1916 sqlite3_finalize(pStmt); 1917 }else{ 1918 /* Everything worked and the cache is operational. 1919 ** Create a new SqlPreparedStmt structure if we need one. 1920 ** (If we already have one we can just reuse it.) 1921 */ 1922 if( pPreStmt==0 ){ 1923 len = zLeft - zSql; 1924 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) ); 1925 if( pPreStmt==0 ) return TCL_ERROR; 1926 pPreStmt->pStmt = pStmt; 1927 pPreStmt->nSql = len; 1928 pPreStmt->zSql = sqlite3_sql(pStmt); 1929 assert( strlen30(pPreStmt->zSql)==len ); 1930 assert( 0==memcmp(pPreStmt->zSql, zSql, len) ); 1931 } 1932 1933 /* Add the prepared statement to the beginning of the cache list 1934 */ 1935 pPreStmt->pNext = pDb->stmtList; 1936 pPreStmt->pPrev = 0; 1937 if( pDb->stmtList ){ 1938 pDb->stmtList->pPrev = pPreStmt; 1939 } 1940 pDb->stmtList = pPreStmt; 1941 if( pDb->stmtLast==0 ){ 1942 assert( pDb->nStmt==0 ); 1943 pDb->stmtLast = pPreStmt; 1944 }else{ 1945 assert( pDb->nStmt>0 ); 1946 } 1947 pDb->nStmt++; 1948 1949 /* If we have too many statement in cache, remove the surplus from the 1950 ** end of the cache list. 1951 */ 1952 while( pDb->nStmt>pDb->maxStmt ){ 1953 sqlite3_finalize(pDb->stmtLast->pStmt); 1954 pDb->stmtLast = pDb->stmtLast->pPrev; 1955 Tcl_Free((char*)pDb->stmtLast->pNext); 1956 pDb->stmtLast->pNext = 0; 1957 pDb->nStmt--; 1958 } 1959 } 1960 1961 /* Proceed to the next statement */ 1962 zSql = zLeft; 1963 } 1964 Tcl_DecrRefCount(objv[2]); 1965 1966 if( pRet ){ 1967 if( rc==TCL_OK ){ 1968 Tcl_SetObjResult(interp, pRet); 1969 } 1970 Tcl_DecrRefCount(pRet); 1971 }else if( rc==TCL_OK ){ 1972 Tcl_ResetResult(interp); 1973 } 1974 break; 1975 } 1976 1977 /* 1978 ** $db function NAME [-argcount N] SCRIPT 1979 ** 1980 ** Create a new SQL function called NAME. Whenever that function is 1981 ** called, invoke SCRIPT to evaluate the function. 1982 */ 1983 case DB_FUNCTION: { 1984 SqlFunc *pFunc; 1985 Tcl_Obj *pScript; 1986 char *zName; 1987 int nArg = -1; 1988 if( objc==6 ){ 1989 const char *z = Tcl_GetString(objv[3]); 1990 int n = strlen30(z); 1991 if( n>2 && strncmp(z, "-argcount",n)==0 ){ 1992 if( Tcl_GetIntFromObj(interp, objv[4], &nArg) ) return TCL_ERROR; 1993 if( nArg<0 ){ 1994 Tcl_AppendResult(interp, "number of arguments must be non-negative", 1995 (char*)0); 1996 return TCL_ERROR; 1997 } 1998 } 1999 pScript = objv[5]; 2000 }else if( objc!=4 ){ 2001 Tcl_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT"); 2002 return TCL_ERROR; 2003 }else{ 2004 pScript = objv[3]; 2005 } 2006 zName = Tcl_GetStringFromObj(objv[2], 0); 2007 pFunc = findSqlFunc(pDb, zName); 2008 if( pFunc==0 ) return TCL_ERROR; 2009 if( pFunc->pScript ){ 2010 Tcl_DecrRefCount(pFunc->pScript); 2011 } 2012 pFunc->pScript = pScript; 2013 Tcl_IncrRefCount(pScript); 2014 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); 2015 rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8, 2016 pFunc, tclSqlFunc, 0, 0); 2017 if( rc!=SQLITE_OK ){ 2018 rc = TCL_ERROR; 2019 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 2020 } 2021 break; 2022 } 2023 2024 /* 2025 ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID 2026 */ 2027 case DB_INCRBLOB: { 2028 #ifdef SQLITE_OMIT_INCRBLOB 2029 Tcl_AppendResult(interp, "incrblob not available in this build", 0); 2030 return TCL_ERROR; 2031 #else 2032 int isReadonly = 0; 2033 const char *zDb = "main"; 2034 const char *zTable; 2035 const char *zColumn; 2036 sqlite_int64 iRow; 2037 2038 /* Check for the -readonly option */ 2039 if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){ 2040 isReadonly = 1; 2041 } 2042 2043 if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){ 2044 Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID"); 2045 return TCL_ERROR; 2046 } 2047 2048 if( objc==(6+isReadonly) ){ 2049 zDb = Tcl_GetString(objv[2]); 2050 } 2051 zTable = Tcl_GetString(objv[objc-3]); 2052 zColumn = Tcl_GetString(objv[objc-2]); 2053 rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow); 2054 2055 if( rc==TCL_OK ){ 2056 rc = createIncrblobChannel( 2057 interp, pDb, zDb, zTable, zColumn, iRow, isReadonly 2058 ); 2059 } 2060 #endif 2061 break; 2062 } 2063 2064 /* 2065 ** $db interrupt 2066 ** 2067 ** Interrupt the execution of the inner-most SQL interpreter. This 2068 ** causes the SQL statement to return an error of SQLITE_INTERRUPT. 2069 */ 2070 case DB_INTERRUPT: { 2071 sqlite3_interrupt(pDb->db); 2072 break; 2073 } 2074 2075 /* 2076 ** $db nullvalue ?STRING? 2077 ** 2078 ** Change text used when a NULL comes back from the database. If ?STRING? 2079 ** is not present, then the current string used for NULL is returned. 2080 ** If STRING is present, then STRING is returned. 2081 ** 2082 */ 2083 case DB_NULLVALUE: { 2084 if( objc!=2 && objc!=3 ){ 2085 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE"); 2086 return TCL_ERROR; 2087 } 2088 if( objc==3 ){ 2089 int len; 2090 char *zNull = Tcl_GetStringFromObj(objv[2], &len); 2091 if( pDb->zNull ){ 2092 Tcl_Free(pDb->zNull); 2093 } 2094 if( zNull && len>0 ){ 2095 pDb->zNull = Tcl_Alloc( len + 1 ); 2096 strncpy(pDb->zNull, zNull, len); 2097 pDb->zNull[len] = '\0'; 2098 }else{ 2099 pDb->zNull = 0; 2100 } 2101 } 2102 Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull)); 2103 break; 2104 } 2105 2106 /* 2107 ** $db last_insert_rowid 2108 ** 2109 ** Return an integer which is the ROWID for the most recent insert. 2110 */ 2111 case DB_LAST_INSERT_ROWID: { 2112 Tcl_Obj *pResult; 2113 Tcl_WideInt rowid; 2114 if( objc!=2 ){ 2115 Tcl_WrongNumArgs(interp, 2, objv, ""); 2116 return TCL_ERROR; 2117 } 2118 rowid = sqlite3_last_insert_rowid(pDb->db); 2119 pResult = Tcl_GetObjResult(interp); 2120 Tcl_SetWideIntObj(pResult, rowid); 2121 break; 2122 } 2123 2124 /* 2125 ** The DB_ONECOLUMN method is implemented together with DB_EVAL. 2126 */ 2127 2128 /* $db progress ?N CALLBACK? 2129 ** 2130 ** Invoke the given callback every N virtual machine opcodes while executing 2131 ** queries. 2132 */ 2133 case DB_PROGRESS: { 2134 if( objc==2 ){ 2135 if( pDb->zProgress ){ 2136 Tcl_AppendResult(interp, pDb->zProgress, 0); 2137 } 2138 }else if( objc==4 ){ 2139 char *zProgress; 2140 int len; 2141 int N; 2142 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){ 2143 return TCL_ERROR; 2144 }; 2145 if( pDb->zProgress ){ 2146 Tcl_Free(pDb->zProgress); 2147 } 2148 zProgress = Tcl_GetStringFromObj(objv[3], &len); 2149 if( zProgress && len>0 ){ 2150 pDb->zProgress = Tcl_Alloc( len + 1 ); 2151 memcpy(pDb->zProgress, zProgress, len+1); 2152 }else{ 2153 pDb->zProgress = 0; 2154 } 2155 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK 2156 if( pDb->zProgress ){ 2157 pDb->interp = interp; 2158 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); 2159 }else{ 2160 sqlite3_progress_handler(pDb->db, 0, 0, 0); 2161 } 2162 #endif 2163 }else{ 2164 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK"); 2165 return TCL_ERROR; 2166 } 2167 break; 2168 } 2169 2170 /* $db profile ?CALLBACK? 2171 ** 2172 ** Make arrangements to invoke the CALLBACK routine after each SQL statement 2173 ** that has run. The text of the SQL and the amount of elapse time are 2174 ** appended to CALLBACK before the script is run. 2175 */ 2176 case DB_PROFILE: { 2177 if( objc>3 ){ 2178 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 2179 return TCL_ERROR; 2180 }else if( objc==2 ){ 2181 if( pDb->zProfile ){ 2182 Tcl_AppendResult(interp, pDb->zProfile, 0); 2183 } 2184 }else{ 2185 char *zProfile; 2186 int len; 2187 if( pDb->zProfile ){ 2188 Tcl_Free(pDb->zProfile); 2189 } 2190 zProfile = Tcl_GetStringFromObj(objv[2], &len); 2191 if( zProfile && len>0 ){ 2192 pDb->zProfile = Tcl_Alloc( len + 1 ); 2193 memcpy(pDb->zProfile, zProfile, len+1); 2194 }else{ 2195 pDb->zProfile = 0; 2196 } 2197 #ifndef SQLITE_OMIT_TRACE 2198 if( pDb->zProfile ){ 2199 pDb->interp = interp; 2200 sqlite3_profile(pDb->db, DbProfileHandler, pDb); 2201 }else{ 2202 sqlite3_profile(pDb->db, 0, 0); 2203 } 2204 #endif 2205 } 2206 break; 2207 } 2208 2209 /* 2210 ** $db rekey KEY 2211 ** 2212 ** Change the encryption key on the currently open database. 2213 */ 2214 case DB_REKEY: { 2215 int nKey; 2216 void *pKey; 2217 if( objc!=3 ){ 2218 Tcl_WrongNumArgs(interp, 2, objv, "KEY"); 2219 return TCL_ERROR; 2220 } 2221 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey); 2222 #ifdef SQLITE_HAS_CODEC 2223 rc = sqlite3_rekey(pDb->db, pKey, nKey); 2224 if( rc ){ 2225 Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0); 2226 rc = TCL_ERROR; 2227 } 2228 #endif 2229 break; 2230 } 2231 2232 /* $db restore ?DATABASE? FILENAME 2233 ** 2234 ** Open a database file named FILENAME. Transfer the content 2235 ** of FILENAME into the local database DATABASE (default: "main"). 2236 */ 2237 case DB_RESTORE: { 2238 const char *zSrcFile; 2239 const char *zDestDb; 2240 sqlite3 *pSrc; 2241 sqlite3_backup *pBackup; 2242 int nTimeout = 0; 2243 2244 if( objc==3 ){ 2245 zDestDb = "main"; 2246 zSrcFile = Tcl_GetString(objv[2]); 2247 }else if( objc==4 ){ 2248 zDestDb = Tcl_GetString(objv[2]); 2249 zSrcFile = Tcl_GetString(objv[3]); 2250 }else{ 2251 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); 2252 return TCL_ERROR; 2253 } 2254 rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0); 2255 if( rc!=SQLITE_OK ){ 2256 Tcl_AppendResult(interp, "cannot open source database: ", 2257 sqlite3_errmsg(pSrc), (char*)0); 2258 sqlite3_close(pSrc); 2259 return TCL_ERROR; 2260 } 2261 pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main"); 2262 if( pBackup==0 ){ 2263 Tcl_AppendResult(interp, "restore failed: ", 2264 sqlite3_errmsg(pDb->db), (char*)0); 2265 sqlite3_close(pSrc); 2266 return TCL_ERROR; 2267 } 2268 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK 2269 || rc==SQLITE_BUSY ){ 2270 if( rc==SQLITE_BUSY ){ 2271 if( nTimeout++ >= 3 ) break; 2272 sqlite3_sleep(100); 2273 } 2274 } 2275 sqlite3_backup_finish(pBackup); 2276 if( rc==SQLITE_DONE ){ 2277 rc = TCL_OK; 2278 }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){ 2279 Tcl_AppendResult(interp, "restore failed: source database busy", 2280 (char*)0); 2281 rc = TCL_ERROR; 2282 }else{ 2283 Tcl_AppendResult(interp, "restore failed: ", 2284 sqlite3_errmsg(pDb->db), (char*)0); 2285 rc = TCL_ERROR; 2286 } 2287 sqlite3_close(pSrc); 2288 break; 2289 } 2290 2291 /* 2292 ** $db status (step|sort) 2293 ** 2294 ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or 2295 ** SQLITE_STMTSTATUS_SORT for the most recent eval. 2296 */ 2297 case DB_STATUS: { 2298 int v; 2299 const char *zOp; 2300 if( objc!=3 ){ 2301 Tcl_WrongNumArgs(interp, 2, objv, "(step|sort)"); 2302 return TCL_ERROR; 2303 } 2304 zOp = Tcl_GetString(objv[2]); 2305 if( strcmp(zOp, "step")==0 ){ 2306 v = pDb->nStep; 2307 }else if( strcmp(zOp, "sort")==0 ){ 2308 v = pDb->nSort; 2309 }else{ 2310 Tcl_AppendResult(interp, "bad argument: should be step or sort", 2311 (char*)0); 2312 return TCL_ERROR; 2313 } 2314 Tcl_SetObjResult(interp, Tcl_NewIntObj(v)); 2315 break; 2316 } 2317 2318 /* 2319 ** $db timeout MILLESECONDS 2320 ** 2321 ** Delay for the number of milliseconds specified when a file is locked. 2322 */ 2323 case DB_TIMEOUT: { 2324 int ms; 2325 if( objc!=3 ){ 2326 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); 2327 return TCL_ERROR; 2328 } 2329 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR; 2330 sqlite3_busy_timeout(pDb->db, ms); 2331 break; 2332 } 2333 2334 /* 2335 ** $db total_changes 2336 ** 2337 ** Return the number of rows that were modified, inserted, or deleted 2338 ** since the database handle was created. 2339 */ 2340 case DB_TOTAL_CHANGES: { 2341 Tcl_Obj *pResult; 2342 if( objc!=2 ){ 2343 Tcl_WrongNumArgs(interp, 2, objv, ""); 2344 return TCL_ERROR; 2345 } 2346 pResult = Tcl_GetObjResult(interp); 2347 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db)); 2348 break; 2349 } 2350 2351 /* $db trace ?CALLBACK? 2352 ** 2353 ** Make arrangements to invoke the CALLBACK routine for each SQL statement 2354 ** that is executed. The text of the SQL is appended to CALLBACK before 2355 ** it is executed. 2356 */ 2357 case DB_TRACE: { 2358 if( objc>3 ){ 2359 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 2360 return TCL_ERROR; 2361 }else if( objc==2 ){ 2362 if( pDb->zTrace ){ 2363 Tcl_AppendResult(interp, pDb->zTrace, 0); 2364 } 2365 }else{ 2366 char *zTrace; 2367 int len; 2368 if( pDb->zTrace ){ 2369 Tcl_Free(pDb->zTrace); 2370 } 2371 zTrace = Tcl_GetStringFromObj(objv[2], &len); 2372 if( zTrace && len>0 ){ 2373 pDb->zTrace = Tcl_Alloc( len + 1 ); 2374 memcpy(pDb->zTrace, zTrace, len+1); 2375 }else{ 2376 pDb->zTrace = 0; 2377 } 2378 #ifndef SQLITE_OMIT_TRACE 2379 if( pDb->zTrace ){ 2380 pDb->interp = interp; 2381 sqlite3_trace(pDb->db, DbTraceHandler, pDb); 2382 }else{ 2383 sqlite3_trace(pDb->db, 0, 0); 2384 } 2385 #endif 2386 } 2387 break; 2388 } 2389 2390 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT 2391 ** 2392 ** Start a new transaction (if we are not already in the midst of a 2393 ** transaction) and execute the TCL script SCRIPT. After SCRIPT 2394 ** completes, either commit the transaction or roll it back if SCRIPT 2395 ** throws an exception. Or if no new transation was started, do nothing. 2396 ** pass the exception on up the stack. 2397 ** 2398 ** This command was inspired by Dave Thomas's talk on Ruby at the 2399 ** 2005 O'Reilly Open Source Convention (OSCON). 2400 */ 2401 case DB_TRANSACTION: { 2402 Tcl_Obj *pScript; 2403 const char *zBegin = "SAVEPOINT _tcl_transaction"; 2404 const char *zEnd; 2405 if( objc!=3 && objc!=4 ){ 2406 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); 2407 return TCL_ERROR; 2408 } 2409 2410 if( pDb->nTransaction ){ 2411 zBegin = "SAVEPOINT _tcl_transaction"; 2412 }else if( pDb->nTransaction==0 && objc==4 ){ 2413 static const char *TTYPE_strs[] = { 2414 "deferred", "exclusive", "immediate", 0 2415 }; 2416 enum TTYPE_enum { 2417 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE 2418 }; 2419 int ttype; 2420 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type", 2421 0, &ttype) ){ 2422 return TCL_ERROR; 2423 } 2424 switch( (enum TTYPE_enum)ttype ){ 2425 case TTYPE_DEFERRED: /* no-op */; break; 2426 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; 2427 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; 2428 } 2429 } 2430 pScript = objv[objc-1]; 2431 2432 pDb->disableAuth++; 2433 rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0); 2434 pDb->disableAuth--; 2435 if( rc!=SQLITE_OK ){ 2436 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); 2437 return TCL_ERROR; 2438 } 2439 2440 pDb->nTransaction++; 2441 rc = Tcl_EvalObjEx(interp, pScript, 0); 2442 pDb->nTransaction--; 2443 2444 if( rc!=TCL_ERROR ){ 2445 if( pDb->nTransaction ){ 2446 zEnd = "RELEASE _tcl_transaction"; 2447 }else{ 2448 zEnd = "COMMIT"; 2449 } 2450 }else{ 2451 if( pDb->nTransaction ){ 2452 zEnd = "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction"; 2453 }else{ 2454 zEnd = "ROLLBACK"; 2455 } 2456 } 2457 2458 pDb->disableAuth++; 2459 if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ 2460 /* This is a tricky scenario to handle. The most likely cause of an 2461 ** error is that the exec() above was an attempt to commit the 2462 ** top-level transaction that returned SQLITE_BUSY. Or, less likely, 2463 ** that an IO-error has occured. In either case, throw a Tcl exception 2464 ** and try to rollback the transaction. 2465 ** 2466 ** But it could also be that the user executed one or more BEGIN, 2467 ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing 2468 ** this method's logic. Not clear how this would be best handled. 2469 */ 2470 if( rc!=TCL_ERROR ){ 2471 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); 2472 rc = TCL_ERROR; 2473 } 2474 sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); 2475 } 2476 pDb->disableAuth--; 2477 2478 break; 2479 } 2480 2481 /* 2482 ** $db unlock_notify ?script? 2483 */ 2484 case DB_UNLOCK_NOTIFY: { 2485 #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY 2486 Tcl_AppendResult(interp, "unlock_notify not available in this build", 0); 2487 rc = TCL_ERROR; 2488 #else 2489 if( objc!=2 && objc!=3 ){ 2490 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); 2491 rc = TCL_ERROR; 2492 }else{ 2493 void (*xNotify)(void **, int) = 0; 2494 void *pNotifyArg = 0; 2495 2496 if( pDb->pUnlockNotify ){ 2497 Tcl_DecrRefCount(pDb->pUnlockNotify); 2498 pDb->pUnlockNotify = 0; 2499 } 2500 2501 if( objc==3 ){ 2502 xNotify = DbUnlockNotify; 2503 pNotifyArg = (void *)pDb; 2504 pDb->pUnlockNotify = objv[2]; 2505 Tcl_IncrRefCount(pDb->pUnlockNotify); 2506 } 2507 2508 if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){ 2509 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); 2510 rc = TCL_ERROR; 2511 } 2512 } 2513 #endif 2514 break; 2515 } 2516 2517 /* 2518 ** $db update_hook ?script? 2519 ** $db rollback_hook ?script? 2520 */ 2521 case DB_UPDATE_HOOK: 2522 case DB_ROLLBACK_HOOK: { 2523 2524 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on 2525 ** whether [$db update_hook] or [$db rollback_hook] was invoked. 2526 */ 2527 Tcl_Obj **ppHook; 2528 if( choice==DB_UPDATE_HOOK ){ 2529 ppHook = &pDb->pUpdateHook; 2530 }else{ 2531 ppHook = &pDb->pRollbackHook; 2532 } 2533 2534 if( objc!=2 && objc!=3 ){ 2535 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); 2536 return TCL_ERROR; 2537 } 2538 if( *ppHook ){ 2539 Tcl_SetObjResult(interp, *ppHook); 2540 if( objc==3 ){ 2541 Tcl_DecrRefCount(*ppHook); 2542 *ppHook = 0; 2543 } 2544 } 2545 if( objc==3 ){ 2546 assert( !(*ppHook) ); 2547 if( Tcl_GetCharLength(objv[2])>0 ){ 2548 *ppHook = objv[2]; 2549 Tcl_IncrRefCount(*ppHook); 2550 } 2551 } 2552 2553 sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); 2554 sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); 2555 2556 break; 2557 } 2558 2559 /* $db version 2560 ** 2561 ** Return the version string for this database. 2562 */ 2563 case DB_VERSION: { 2564 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC); 2565 break; 2566 } 2567 2568 2569 } /* End of the SWITCH statement */ 2570 return rc; 2571 } 2572 2573 /* 2574 ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? 2575 ** ?-create BOOLEAN? ?-nomutex BOOLEAN? 2576 ** 2577 ** This is the main Tcl command. When the "sqlite" Tcl command is 2578 ** invoked, this routine runs to process that command. 2579 ** 2580 ** The first argument, DBNAME, is an arbitrary name for a new 2581 ** database connection. This command creates a new command named 2582 ** DBNAME that is used to control that connection. The database 2583 ** connection is deleted when the DBNAME command is deleted. 2584 ** 2585 ** The second argument is the name of the database file. 2586 ** 2587 */ 2588 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 2589 SqliteDb *p; 2590 void *pKey = 0; 2591 int nKey = 0; 2592 const char *zArg; 2593 char *zErrMsg; 2594 int i; 2595 const char *zFile; 2596 const char *zVfs = 0; 2597 int flags; 2598 Tcl_DString translatedFilename; 2599 2600 /* In normal use, each TCL interpreter runs in a single thread. So 2601 ** by default, we can turn of mutexing on SQLite database connections. 2602 ** However, for testing purposes it is useful to have mutexes turned 2603 ** on. So, by default, mutexes default off. But if compiled with 2604 ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on. 2605 */ 2606 #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX 2607 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX; 2608 #else 2609 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX; 2610 #endif 2611 2612 if( objc==2 ){ 2613 zArg = Tcl_GetStringFromObj(objv[1], 0); 2614 if( strcmp(zArg,"-version")==0 ){ 2615 Tcl_AppendResult(interp,sqlite3_version,0); 2616 return TCL_OK; 2617 } 2618 if( strcmp(zArg,"-has-codec")==0 ){ 2619 #ifdef SQLITE_HAS_CODEC 2620 Tcl_AppendResult(interp,"1",0); 2621 #else 2622 Tcl_AppendResult(interp,"0",0); 2623 #endif 2624 return TCL_OK; 2625 } 2626 } 2627 for(i=3; i+1<objc; i+=2){ 2628 zArg = Tcl_GetString(objv[i]); 2629 if( strcmp(zArg,"-key")==0 ){ 2630 pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey); 2631 }else if( strcmp(zArg, "-vfs")==0 ){ 2632 i++; 2633 zVfs = Tcl_GetString(objv[i]); 2634 }else if( strcmp(zArg, "-readonly")==0 ){ 2635 int b; 2636 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2637 if( b ){ 2638 flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE); 2639 flags |= SQLITE_OPEN_READONLY; 2640 }else{ 2641 flags &= ~SQLITE_OPEN_READONLY; 2642 flags |= SQLITE_OPEN_READWRITE; 2643 } 2644 }else if( strcmp(zArg, "-create")==0 ){ 2645 int b; 2646 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2647 if( b && (flags & SQLITE_OPEN_READONLY)==0 ){ 2648 flags |= SQLITE_OPEN_CREATE; 2649 }else{ 2650 flags &= ~SQLITE_OPEN_CREATE; 2651 } 2652 }else if( strcmp(zArg, "-nomutex")==0 ){ 2653 int b; 2654 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2655 if( b ){ 2656 flags |= SQLITE_OPEN_NOMUTEX; 2657 flags &= ~SQLITE_OPEN_FULLMUTEX; 2658 }else{ 2659 flags &= ~SQLITE_OPEN_NOMUTEX; 2660 } 2661 }else if( strcmp(zArg, "-fullmutex")==0 ){ 2662 int b; 2663 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2664 if( b ){ 2665 flags |= SQLITE_OPEN_FULLMUTEX; 2666 flags &= ~SQLITE_OPEN_NOMUTEX; 2667 }else{ 2668 flags &= ~SQLITE_OPEN_FULLMUTEX; 2669 } 2670 }else{ 2671 Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0); 2672 return TCL_ERROR; 2673 } 2674 } 2675 if( objc<3 || (objc&1)!=1 ){ 2676 Tcl_WrongNumArgs(interp, 1, objv, 2677 "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?" 2678 " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?" 2679 #ifdef SQLITE_HAS_CODEC 2680 " ?-key CODECKEY?" 2681 #endif 2682 ); 2683 return TCL_ERROR; 2684 } 2685 zErrMsg = 0; 2686 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) ); 2687 if( p==0 ){ 2688 Tcl_SetResult(interp, "malloc failed", TCL_STATIC); 2689 return TCL_ERROR; 2690 } 2691 memset(p, 0, sizeof(*p)); 2692 zFile = Tcl_GetStringFromObj(objv[2], 0); 2693 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename); 2694 sqlite3_open_v2(zFile, &p->db, flags, zVfs); 2695 Tcl_DStringFree(&translatedFilename); 2696 if( SQLITE_OK!=sqlite3_errcode(p->db) ){ 2697 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); 2698 sqlite3_close(p->db); 2699 p->db = 0; 2700 } 2701 #ifdef SQLITE_HAS_CODEC 2702 if( p->db ){ 2703 sqlite3_key(p->db, pKey, nKey); 2704 } 2705 #endif 2706 if( p->db==0 ){ 2707 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); 2708 Tcl_Free((char*)p); 2709 sqlite3_free(zErrMsg); 2710 return TCL_ERROR; 2711 } 2712 p->maxStmt = NUM_PREPARED_STMTS; 2713 p->interp = interp; 2714 zArg = Tcl_GetStringFromObj(objv[1], 0); 2715 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); 2716 return TCL_OK; 2717 } 2718 2719 /* 2720 ** Provide a dummy Tcl_InitStubs if we are using this as a static 2721 ** library. 2722 */ 2723 #ifndef USE_TCL_STUBS 2724 # undef Tcl_InitStubs 2725 # define Tcl_InitStubs(a,b,c) 2726 #endif 2727 2728 /* 2729 ** Make sure we have a PACKAGE_VERSION macro defined. This will be 2730 ** defined automatically by the TEA makefile. But other makefiles 2731 ** do not define it. 2732 */ 2733 #ifndef PACKAGE_VERSION 2734 # define PACKAGE_VERSION SQLITE_VERSION 2735 #endif 2736 2737 /* 2738 ** Initialize this module. 2739 ** 2740 ** This Tcl module contains only a single new Tcl command named "sqlite". 2741 ** (Hence there is no namespace. There is no point in using a namespace 2742 ** if the extension only supplies one new name!) The "sqlite" command is 2743 ** used to open a new SQLite database. See the DbMain() routine above 2744 ** for additional information. 2745 */ 2746 EXTERN int Sqlite3_Init(Tcl_Interp *interp){ 2747 Tcl_InitStubs(interp, "8.4", 0); 2748 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2749 Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION); 2750 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2751 Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION); 2752 return TCL_OK; 2753 } 2754 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2755 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2756 EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2757 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2758 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2759 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2760 EXTERN int Tclsqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;} 2761 2762 2763 #ifndef SQLITE_3_SUFFIX_ONLY 2764 EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2765 EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2766 EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2767 EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2768 EXTERN int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2769 EXTERN int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2770 EXTERN int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2771 EXTERN int Tclsqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;} 2772 #endif 2773 2774 #ifdef TCLSH 2775 /***************************************************************************** 2776 ** The code that follows is used to build standalone TCL interpreters 2777 ** that are statically linked with SQLite. 2778 */ 2779 2780 /* 2781 ** If the macro TCLSH is one, then put in code this for the 2782 ** "main" routine that will initialize Tcl and take input from 2783 ** standard input, or if a file is named on the command line 2784 ** the TCL interpreter reads and evaluates that file. 2785 */ 2786 #if TCLSH==1 2787 static char zMainloop[] = 2788 "set line {}\n" 2789 "while {![eof stdin]} {\n" 2790 "if {$line!=\"\"} {\n" 2791 "puts -nonewline \"> \"\n" 2792 "} else {\n" 2793 "puts -nonewline \"% \"\n" 2794 "}\n" 2795 "flush stdout\n" 2796 "append line [gets stdin]\n" 2797 "if {[info complete $line]} {\n" 2798 "if {[catch {uplevel #0 $line} result]} {\n" 2799 "puts stderr \"Error: $result\"\n" 2800 "} elseif {$result!=\"\"} {\n" 2801 "puts $result\n" 2802 "}\n" 2803 "set line {}\n" 2804 "} else {\n" 2805 "append line \\n\n" 2806 "}\n" 2807 "}\n" 2808 ; 2809 #endif 2810 2811 /* 2812 ** If the macro TCLSH is two, then get the main loop code out of 2813 ** the separate file "spaceanal_tcl.h". 2814 */ 2815 #if TCLSH==2 2816 static char zMainloop[] = 2817 #include "spaceanal_tcl.h" 2818 ; 2819 #endif 2820 2821 #define TCLSH_MAIN main /* Needed to fake out mktclapp */ 2822 int TCLSH_MAIN(int argc, char **argv){ 2823 Tcl_Interp *interp; 2824 2825 /* Call sqlite3_shutdown() once before doing anything else. This is to 2826 ** test that sqlite3_shutdown() can be safely called by a process before 2827 ** sqlite3_initialize() is. */ 2828 sqlite3_shutdown(); 2829 2830 Tcl_FindExecutable(argv[0]); 2831 interp = Tcl_CreateInterp(); 2832 Sqlite3_Init(interp); 2833 #ifdef SQLITE_TEST 2834 { 2835 extern int Md5_Init(Tcl_Interp*); 2836 extern int Sqliteconfig_Init(Tcl_Interp*); 2837 extern int Sqlitetest1_Init(Tcl_Interp*); 2838 extern int Sqlitetest2_Init(Tcl_Interp*); 2839 extern int Sqlitetest3_Init(Tcl_Interp*); 2840 extern int Sqlitetest4_Init(Tcl_Interp*); 2841 extern int Sqlitetest5_Init(Tcl_Interp*); 2842 extern int Sqlitetest6_Init(Tcl_Interp*); 2843 extern int Sqlitetest7_Init(Tcl_Interp*); 2844 extern int Sqlitetest8_Init(Tcl_Interp*); 2845 extern int Sqlitetest9_Init(Tcl_Interp*); 2846 extern int Sqlitetestasync_Init(Tcl_Interp*); 2847 extern int Sqlitetest_autoext_Init(Tcl_Interp*); 2848 extern int Sqlitetest_func_Init(Tcl_Interp*); 2849 extern int Sqlitetest_hexio_Init(Tcl_Interp*); 2850 extern int Sqlitetest_init_Init(Tcl_Interp*); 2851 extern int Sqlitetest_malloc_Init(Tcl_Interp*); 2852 extern int Sqlitetest_mutex_Init(Tcl_Interp*); 2853 extern int Sqlitetestschema_Init(Tcl_Interp*); 2854 extern int Sqlitetestsse_Init(Tcl_Interp*); 2855 extern int Sqlitetesttclvar_Init(Tcl_Interp*); 2856 extern int SqlitetestThread_Init(Tcl_Interp*); 2857 extern int SqlitetestOnefile_Init(); 2858 extern int SqlitetestOsinst_Init(Tcl_Interp*); 2859 extern int Sqlitetestbackup_Init(Tcl_Interp*); 2860 2861 Md5_Init(interp); 2862 Sqliteconfig_Init(interp); 2863 Sqlitetest1_Init(interp); 2864 Sqlitetest2_Init(interp); 2865 Sqlitetest3_Init(interp); 2866 Sqlitetest4_Init(interp); 2867 Sqlitetest5_Init(interp); 2868 Sqlitetest6_Init(interp); 2869 Sqlitetest7_Init(interp); 2870 Sqlitetest8_Init(interp); 2871 Sqlitetest9_Init(interp); 2872 Sqlitetestasync_Init(interp); 2873 Sqlitetest_autoext_Init(interp); 2874 Sqlitetest_func_Init(interp); 2875 Sqlitetest_hexio_Init(interp); 2876 Sqlitetest_init_Init(interp); 2877 Sqlitetest_malloc_Init(interp); 2878 Sqlitetest_mutex_Init(interp); 2879 Sqlitetestschema_Init(interp); 2880 Sqlitetesttclvar_Init(interp); 2881 SqlitetestThread_Init(interp); 2882 SqlitetestOnefile_Init(interp); 2883 SqlitetestOsinst_Init(interp); 2884 Sqlitetestbackup_Init(interp); 2885 2886 #ifdef SQLITE_SSE 2887 Sqlitetestsse_Init(interp); 2888 #endif 2889 } 2890 #endif 2891 if( argc>=2 || TCLSH==2 ){ 2892 int i; 2893 char zArgc[32]; 2894 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH)); 2895 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY); 2896 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); 2897 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); 2898 for(i=3-TCLSH; i<argc; i++){ 2899 Tcl_SetVar(interp, "argv", argv[i], 2900 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); 2901 } 2902 if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ 2903 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); 2904 if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp); 2905 fprintf(stderr,"%s: %s\n", *argv, zInfo); 2906 return 1; 2907 } 2908 } 2909 if( argc<=1 || TCLSH==2 ){ 2910 Tcl_GlobalEval(interp, zMainloop); 2911 } 2912 return 0; 2913 } 2914 #endif /* TCLSH */ 2915