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