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.241 2009/03/27 12:44:35 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 len = strlen30(zSql); 1678 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){ 1679 int n = pPreStmt->nSql; 1680 if( len>=n 1681 && memcmp(pPreStmt->zSql, zSql, n)==0 1682 && (zSql[n]==0 || zSql[n-1]==';') 1683 ){ 1684 pStmt = pPreStmt->pStmt; 1685 zLeft = &zSql[pPreStmt->nSql]; 1686 1687 /* When a prepared statement is found, unlink it from the 1688 ** cache list. It will later be added back to the beginning 1689 ** of the cache list in order to implement LRU replacement. 1690 */ 1691 if( pPreStmt->pPrev ){ 1692 pPreStmt->pPrev->pNext = pPreStmt->pNext; 1693 }else{ 1694 pDb->stmtList = pPreStmt->pNext; 1695 } 1696 if( pPreStmt->pNext ){ 1697 pPreStmt->pNext->pPrev = pPreStmt->pPrev; 1698 }else{ 1699 pDb->stmtLast = pPreStmt->pPrev; 1700 } 1701 pDb->nStmt--; 1702 break; 1703 } 1704 } 1705 1706 /* If no prepared statement was found. Compile the SQL text 1707 */ 1708 if( pStmt==0 ){ 1709 if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, &zLeft) ){ 1710 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1711 rc = TCL_ERROR; 1712 break; 1713 } 1714 if( pStmt==0 ){ 1715 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ 1716 /* A compile-time error in the statement 1717 */ 1718 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1719 rc = TCL_ERROR; 1720 break; 1721 }else{ 1722 /* The statement was a no-op. Continue to the next statement 1723 ** in the SQL string. 1724 */ 1725 zSql = zLeft; 1726 continue; 1727 } 1728 } 1729 assert( pPreStmt==0 ); 1730 } 1731 1732 /* Bind values to parameters that begin with $ or : 1733 */ 1734 nVar = sqlite3_bind_parameter_count(pStmt); 1735 nParm = 0; 1736 if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){ 1737 apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0])); 1738 }else{ 1739 apParm = aParm; 1740 } 1741 for(i=1; i<=nVar; i++){ 1742 const char *zVar = sqlite3_bind_parameter_name(pStmt, i); 1743 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){ 1744 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0); 1745 if( pVar ){ 1746 int n; 1747 u8 *data; 1748 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 1749 char c = zType[0]; 1750 if( zVar[0]=='@' || 1751 (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){ 1752 /* Load a BLOB type if the Tcl variable is a bytearray and 1753 ** it has no string representation or the host 1754 ** parameter name begins with "@". */ 1755 data = Tcl_GetByteArrayFromObj(pVar, &n); 1756 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); 1757 Tcl_IncrRefCount(pVar); 1758 apParm[nParm++] = pVar; 1759 }else if( c=='b' && strcmp(zType,"boolean")==0 ){ 1760 Tcl_GetIntFromObj(interp, pVar, &n); 1761 sqlite3_bind_int(pStmt, i, n); 1762 }else if( c=='d' && strcmp(zType,"double")==0 ){ 1763 double r; 1764 Tcl_GetDoubleFromObj(interp, pVar, &r); 1765 sqlite3_bind_double(pStmt, i, r); 1766 }else if( (c=='w' && strcmp(zType,"wideInt")==0) || 1767 (c=='i' && strcmp(zType,"int")==0) ){ 1768 Tcl_WideInt v; 1769 Tcl_GetWideIntFromObj(interp, pVar, &v); 1770 sqlite3_bind_int64(pStmt, i, v); 1771 }else{ 1772 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 1773 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); 1774 Tcl_IncrRefCount(pVar); 1775 apParm[nParm++] = pVar; 1776 } 1777 }else{ 1778 sqlite3_bind_null( pStmt, i ); 1779 } 1780 } 1781 } 1782 1783 /* Execute the SQL 1784 */ 1785 while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){ 1786 1787 /* Compute column names. This must be done after the first successful 1788 ** call to sqlite3_step(), in case the query is recompiled and the 1789 ** number or names of the returned columns changes. 1790 */ 1791 assert(!pArray||pScript); 1792 if (nCol < 0) { 1793 Tcl_Obj ***ap = (pScript?&apColName:0); 1794 nCol = computeColumnNames(interp, pStmt, ap, pArray); 1795 } 1796 1797 for(i=0; i<nCol; i++){ 1798 Tcl_Obj *pVal; 1799 1800 /* Set pVal to contain the i'th column of this row. */ 1801 switch( sqlite3_column_type(pStmt, i) ){ 1802 case SQLITE_BLOB: { 1803 int bytes = sqlite3_column_bytes(pStmt, i); 1804 const char *zBlob = sqlite3_column_blob(pStmt, i); 1805 if( !zBlob ) bytes = 0; 1806 pVal = Tcl_NewByteArrayObj((u8*)zBlob, bytes); 1807 break; 1808 } 1809 case SQLITE_INTEGER: { 1810 sqlite_int64 v = sqlite3_column_int64(pStmt, i); 1811 if( v>=-2147483647 && v<=2147483647 ){ 1812 pVal = Tcl_NewIntObj(v); 1813 }else{ 1814 pVal = Tcl_NewWideIntObj(v); 1815 } 1816 break; 1817 } 1818 case SQLITE_FLOAT: { 1819 double r = sqlite3_column_double(pStmt, i); 1820 pVal = Tcl_NewDoubleObj(r); 1821 break; 1822 } 1823 case SQLITE_NULL: { 1824 pVal = dbTextToObj(pDb->zNull); 1825 break; 1826 } 1827 default: { 1828 pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i)); 1829 break; 1830 } 1831 } 1832 1833 if( pScript ){ 1834 if( pArray==0 ){ 1835 Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); 1836 }else{ 1837 Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); 1838 } 1839 }else if( choice==DB_ONECOLUMN ){ 1840 assert( pRet==0 ); 1841 if( pRet==0 ){ 1842 pRet = pVal; 1843 Tcl_IncrRefCount(pRet); 1844 } 1845 rc = TCL_BREAK; 1846 i = nCol; 1847 }else if( choice==DB_EXISTS ){ 1848 Tcl_DecrRefCount(pRet); 1849 pRet = Tcl_NewBooleanObj(1); 1850 Tcl_IncrRefCount(pRet); 1851 rc = TCL_BREAK; 1852 i = nCol; 1853 }else{ 1854 Tcl_ListObjAppendElement(interp, pRet, pVal); 1855 } 1856 } 1857 1858 if( pScript ){ 1859 pDb->nStep = sqlite3_stmt_status(pStmt, 1860 SQLITE_STMTSTATUS_FULLSCAN_STEP, 0); 1861 pDb->nSort = sqlite3_stmt_status(pStmt, 1862 SQLITE_STMTSTATUS_SORT, 0); 1863 rc = Tcl_EvalObjEx(interp, pScript, 0); 1864 if( rc==TCL_CONTINUE ){ 1865 rc = TCL_OK; 1866 } 1867 } 1868 } 1869 if( rc==TCL_BREAK ){ 1870 rc = TCL_OK; 1871 } 1872 1873 /* Free the column name objects */ 1874 if( pScript ){ 1875 /* If the query returned no rows, but an array variable was 1876 ** specified, call computeColumnNames() now to populate the 1877 ** arrayname(*) variable. 1878 */ 1879 if (pArray && nCol < 0) { 1880 Tcl_Obj ***ap = (pScript?&apColName:0); 1881 nCol = computeColumnNames(interp, pStmt, ap, pArray); 1882 } 1883 for(i=0; i<nCol; i++){ 1884 Tcl_DecrRefCount(apColName[i]); 1885 } 1886 Tcl_Free((char*)apColName); 1887 } 1888 1889 /* Free the bound string and blob parameters */ 1890 for(i=0; i<nParm; i++){ 1891 Tcl_DecrRefCount(apParm[i]); 1892 } 1893 if( apParm!=aParm ){ 1894 Tcl_Free((char*)apParm); 1895 } 1896 1897 /* Reset the statement. If the result code is SQLITE_SCHEMA, then 1898 ** flush the statement cache and try the statement again. 1899 */ 1900 rc2 = sqlite3_reset(pStmt); 1901 pDb->nStep = sqlite3_stmt_status(pStmt, 1902 SQLITE_STMTSTATUS_FULLSCAN_STEP, 1); 1903 pDb->nSort = sqlite3_stmt_status(pStmt, 1904 SQLITE_STMTSTATUS_SORT, 1); 1905 if( SQLITE_OK!=rc2 ){ 1906 /* If a run-time error occurs, report the error and stop reading 1907 ** the SQL 1908 */ 1909 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1910 sqlite3_finalize(pStmt); 1911 rc = TCL_ERROR; 1912 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1913 break; 1914 }else if( pDb->maxStmt<=0 ){ 1915 /* If the cache is turned off, deallocated the statement */ 1916 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1917 sqlite3_finalize(pStmt); 1918 }else{ 1919 /* Everything worked and the cache is operational. 1920 ** Create a new SqlPreparedStmt structure if we need one. 1921 ** (If we already have one we can just reuse it.) 1922 */ 1923 if( pPreStmt==0 ){ 1924 len = zLeft - zSql; 1925 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) ); 1926 if( pPreStmt==0 ) return TCL_ERROR; 1927 pPreStmt->pStmt = pStmt; 1928 pPreStmt->nSql = len; 1929 pPreStmt->zSql = sqlite3_sql(pStmt); 1930 assert( strlen30(pPreStmt->zSql)==len ); 1931 assert( 0==memcmp(pPreStmt->zSql, zSql, len) ); 1932 } 1933 1934 /* Add the prepared statement to the beginning of the cache list 1935 */ 1936 pPreStmt->pNext = pDb->stmtList; 1937 pPreStmt->pPrev = 0; 1938 if( pDb->stmtList ){ 1939 pDb->stmtList->pPrev = pPreStmt; 1940 } 1941 pDb->stmtList = pPreStmt; 1942 if( pDb->stmtLast==0 ){ 1943 assert( pDb->nStmt==0 ); 1944 pDb->stmtLast = pPreStmt; 1945 }else{ 1946 assert( pDb->nStmt>0 ); 1947 } 1948 pDb->nStmt++; 1949 1950 /* If we have too many statement in cache, remove the surplus from the 1951 ** end of the cache list. 1952 */ 1953 while( pDb->nStmt>pDb->maxStmt ){ 1954 sqlite3_finalize(pDb->stmtLast->pStmt); 1955 pDb->stmtLast = pDb->stmtLast->pPrev; 1956 Tcl_Free((char*)pDb->stmtLast->pNext); 1957 pDb->stmtLast->pNext = 0; 1958 pDb->nStmt--; 1959 } 1960 } 1961 1962 /* Proceed to the next statement */ 1963 zSql = zLeft; 1964 } 1965 Tcl_DecrRefCount(objv[2]); 1966 1967 if( pRet ){ 1968 if( rc==TCL_OK ){ 1969 Tcl_SetObjResult(interp, pRet); 1970 } 1971 Tcl_DecrRefCount(pRet); 1972 }else if( rc==TCL_OK ){ 1973 Tcl_ResetResult(interp); 1974 } 1975 break; 1976 } 1977 1978 /* 1979 ** $db function NAME [-argcount N] SCRIPT 1980 ** 1981 ** Create a new SQL function called NAME. Whenever that function is 1982 ** called, invoke SCRIPT to evaluate the function. 1983 */ 1984 case DB_FUNCTION: { 1985 SqlFunc *pFunc; 1986 Tcl_Obj *pScript; 1987 char *zName; 1988 int nArg = -1; 1989 if( objc==6 ){ 1990 const char *z = Tcl_GetString(objv[3]); 1991 int n = strlen30(z); 1992 if( n>2 && strncmp(z, "-argcount",n)==0 ){ 1993 if( Tcl_GetIntFromObj(interp, objv[4], &nArg) ) return TCL_ERROR; 1994 if( nArg<0 ){ 1995 Tcl_AppendResult(interp, "number of arguments must be non-negative", 1996 (char*)0); 1997 return TCL_ERROR; 1998 } 1999 } 2000 pScript = objv[5]; 2001 }else if( objc!=4 ){ 2002 Tcl_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT"); 2003 return TCL_ERROR; 2004 }else{ 2005 pScript = objv[3]; 2006 } 2007 zName = Tcl_GetStringFromObj(objv[2], 0); 2008 pFunc = findSqlFunc(pDb, zName); 2009 if( pFunc==0 ) return TCL_ERROR; 2010 if( pFunc->pScript ){ 2011 Tcl_DecrRefCount(pFunc->pScript); 2012 } 2013 pFunc->pScript = pScript; 2014 Tcl_IncrRefCount(pScript); 2015 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); 2016 rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8, 2017 pFunc, tclSqlFunc, 0, 0); 2018 if( rc!=SQLITE_OK ){ 2019 rc = TCL_ERROR; 2020 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 2021 } 2022 break; 2023 } 2024 2025 /* 2026 ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID 2027 */ 2028 case DB_INCRBLOB: { 2029 #ifdef SQLITE_OMIT_INCRBLOB 2030 Tcl_AppendResult(interp, "incrblob not available in this build", 0); 2031 return TCL_ERROR; 2032 #else 2033 int isReadonly = 0; 2034 const char *zDb = "main"; 2035 const char *zTable; 2036 const char *zColumn; 2037 sqlite_int64 iRow; 2038 2039 /* Check for the -readonly option */ 2040 if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){ 2041 isReadonly = 1; 2042 } 2043 2044 if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){ 2045 Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID"); 2046 return TCL_ERROR; 2047 } 2048 2049 if( objc==(6+isReadonly) ){ 2050 zDb = Tcl_GetString(objv[2]); 2051 } 2052 zTable = Tcl_GetString(objv[objc-3]); 2053 zColumn = Tcl_GetString(objv[objc-2]); 2054 rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow); 2055 2056 if( rc==TCL_OK ){ 2057 rc = createIncrblobChannel( 2058 interp, pDb, zDb, zTable, zColumn, iRow, isReadonly 2059 ); 2060 } 2061 #endif 2062 break; 2063 } 2064 2065 /* 2066 ** $db interrupt 2067 ** 2068 ** Interrupt the execution of the inner-most SQL interpreter. This 2069 ** causes the SQL statement to return an error of SQLITE_INTERRUPT. 2070 */ 2071 case DB_INTERRUPT: { 2072 sqlite3_interrupt(pDb->db); 2073 break; 2074 } 2075 2076 /* 2077 ** $db nullvalue ?STRING? 2078 ** 2079 ** Change text used when a NULL comes back from the database. If ?STRING? 2080 ** is not present, then the current string used for NULL is returned. 2081 ** If STRING is present, then STRING is returned. 2082 ** 2083 */ 2084 case DB_NULLVALUE: { 2085 if( objc!=2 && objc!=3 ){ 2086 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE"); 2087 return TCL_ERROR; 2088 } 2089 if( objc==3 ){ 2090 int len; 2091 char *zNull = Tcl_GetStringFromObj(objv[2], &len); 2092 if( pDb->zNull ){ 2093 Tcl_Free(pDb->zNull); 2094 } 2095 if( zNull && len>0 ){ 2096 pDb->zNull = Tcl_Alloc( len + 1 ); 2097 strncpy(pDb->zNull, zNull, len); 2098 pDb->zNull[len] = '\0'; 2099 }else{ 2100 pDb->zNull = 0; 2101 } 2102 } 2103 Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull)); 2104 break; 2105 } 2106 2107 /* 2108 ** $db last_insert_rowid 2109 ** 2110 ** Return an integer which is the ROWID for the most recent insert. 2111 */ 2112 case DB_LAST_INSERT_ROWID: { 2113 Tcl_Obj *pResult; 2114 Tcl_WideInt rowid; 2115 if( objc!=2 ){ 2116 Tcl_WrongNumArgs(interp, 2, objv, ""); 2117 return TCL_ERROR; 2118 } 2119 rowid = sqlite3_last_insert_rowid(pDb->db); 2120 pResult = Tcl_GetObjResult(interp); 2121 Tcl_SetWideIntObj(pResult, rowid); 2122 break; 2123 } 2124 2125 /* 2126 ** The DB_ONECOLUMN method is implemented together with DB_EVAL. 2127 */ 2128 2129 /* $db progress ?N CALLBACK? 2130 ** 2131 ** Invoke the given callback every N virtual machine opcodes while executing 2132 ** queries. 2133 */ 2134 case DB_PROGRESS: { 2135 if( objc==2 ){ 2136 if( pDb->zProgress ){ 2137 Tcl_AppendResult(interp, pDb->zProgress, 0); 2138 } 2139 }else if( objc==4 ){ 2140 char *zProgress; 2141 int len; 2142 int N; 2143 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){ 2144 return TCL_ERROR; 2145 }; 2146 if( pDb->zProgress ){ 2147 Tcl_Free(pDb->zProgress); 2148 } 2149 zProgress = Tcl_GetStringFromObj(objv[3], &len); 2150 if( zProgress && len>0 ){ 2151 pDb->zProgress = Tcl_Alloc( len + 1 ); 2152 memcpy(pDb->zProgress, zProgress, len+1); 2153 }else{ 2154 pDb->zProgress = 0; 2155 } 2156 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK 2157 if( pDb->zProgress ){ 2158 pDb->interp = interp; 2159 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); 2160 }else{ 2161 sqlite3_progress_handler(pDb->db, 0, 0, 0); 2162 } 2163 #endif 2164 }else{ 2165 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK"); 2166 return TCL_ERROR; 2167 } 2168 break; 2169 } 2170 2171 /* $db profile ?CALLBACK? 2172 ** 2173 ** Make arrangements to invoke the CALLBACK routine after each SQL statement 2174 ** that has run. The text of the SQL and the amount of elapse time are 2175 ** appended to CALLBACK before the script is run. 2176 */ 2177 case DB_PROFILE: { 2178 if( objc>3 ){ 2179 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 2180 return TCL_ERROR; 2181 }else if( objc==2 ){ 2182 if( pDb->zProfile ){ 2183 Tcl_AppendResult(interp, pDb->zProfile, 0); 2184 } 2185 }else{ 2186 char *zProfile; 2187 int len; 2188 if( pDb->zProfile ){ 2189 Tcl_Free(pDb->zProfile); 2190 } 2191 zProfile = Tcl_GetStringFromObj(objv[2], &len); 2192 if( zProfile && len>0 ){ 2193 pDb->zProfile = Tcl_Alloc( len + 1 ); 2194 memcpy(pDb->zProfile, zProfile, len+1); 2195 }else{ 2196 pDb->zProfile = 0; 2197 } 2198 #ifndef SQLITE_OMIT_TRACE 2199 if( pDb->zProfile ){ 2200 pDb->interp = interp; 2201 sqlite3_profile(pDb->db, DbProfileHandler, pDb); 2202 }else{ 2203 sqlite3_profile(pDb->db, 0, 0); 2204 } 2205 #endif 2206 } 2207 break; 2208 } 2209 2210 /* 2211 ** $db rekey KEY 2212 ** 2213 ** Change the encryption key on the currently open database. 2214 */ 2215 case DB_REKEY: { 2216 int nKey; 2217 void *pKey; 2218 if( objc!=3 ){ 2219 Tcl_WrongNumArgs(interp, 2, objv, "KEY"); 2220 return TCL_ERROR; 2221 } 2222 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey); 2223 #ifdef SQLITE_HAS_CODEC 2224 rc = sqlite3_rekey(pDb->db, pKey, nKey); 2225 if( rc ){ 2226 Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0); 2227 rc = TCL_ERROR; 2228 } 2229 #endif 2230 break; 2231 } 2232 2233 /* $db restore ?DATABASE? FILENAME 2234 ** 2235 ** Open a database file named FILENAME. Transfer the content 2236 ** of FILENAME into the local database DATABASE (default: "main"). 2237 */ 2238 case DB_RESTORE: { 2239 const char *zSrcFile; 2240 const char *zDestDb; 2241 sqlite3 *pSrc; 2242 sqlite3_backup *pBackup; 2243 int nTimeout = 0; 2244 2245 if( objc==3 ){ 2246 zDestDb = "main"; 2247 zSrcFile = Tcl_GetString(objv[2]); 2248 }else if( objc==4 ){ 2249 zDestDb = Tcl_GetString(objv[2]); 2250 zSrcFile = Tcl_GetString(objv[3]); 2251 }else{ 2252 Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); 2253 return TCL_ERROR; 2254 } 2255 rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0); 2256 if( rc!=SQLITE_OK ){ 2257 Tcl_AppendResult(interp, "cannot open source database: ", 2258 sqlite3_errmsg(pSrc), (char*)0); 2259 sqlite3_close(pSrc); 2260 return TCL_ERROR; 2261 } 2262 pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main"); 2263 if( pBackup==0 ){ 2264 Tcl_AppendResult(interp, "restore failed: ", 2265 sqlite3_errmsg(pDb->db), (char*)0); 2266 sqlite3_close(pSrc); 2267 return TCL_ERROR; 2268 } 2269 while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK 2270 || rc==SQLITE_BUSY ){ 2271 if( rc==SQLITE_BUSY ){ 2272 if( nTimeout++ >= 3 ) break; 2273 sqlite3_sleep(100); 2274 } 2275 } 2276 sqlite3_backup_finish(pBackup); 2277 if( rc==SQLITE_DONE ){ 2278 rc = TCL_OK; 2279 }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){ 2280 Tcl_AppendResult(interp, "restore failed: source database busy", 2281 (char*)0); 2282 rc = TCL_ERROR; 2283 }else{ 2284 Tcl_AppendResult(interp, "restore failed: ", 2285 sqlite3_errmsg(pDb->db), (char*)0); 2286 rc = TCL_ERROR; 2287 } 2288 sqlite3_close(pSrc); 2289 break; 2290 } 2291 2292 /* 2293 ** $db status (step|sort) 2294 ** 2295 ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or 2296 ** SQLITE_STMTSTATUS_SORT for the most recent eval. 2297 */ 2298 case DB_STATUS: { 2299 int v; 2300 const char *zOp; 2301 if( objc!=3 ){ 2302 Tcl_WrongNumArgs(interp, 2, objv, "(step|sort)"); 2303 return TCL_ERROR; 2304 } 2305 zOp = Tcl_GetString(objv[2]); 2306 if( strcmp(zOp, "step")==0 ){ 2307 v = pDb->nStep; 2308 }else if( strcmp(zOp, "sort")==0 ){ 2309 v = pDb->nSort; 2310 }else{ 2311 Tcl_AppendResult(interp, "bad argument: should be step or sort", 2312 (char*)0); 2313 return TCL_ERROR; 2314 } 2315 Tcl_SetObjResult(interp, Tcl_NewIntObj(v)); 2316 break; 2317 } 2318 2319 /* 2320 ** $db timeout MILLESECONDS 2321 ** 2322 ** Delay for the number of milliseconds specified when a file is locked. 2323 */ 2324 case DB_TIMEOUT: { 2325 int ms; 2326 if( objc!=3 ){ 2327 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); 2328 return TCL_ERROR; 2329 } 2330 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR; 2331 sqlite3_busy_timeout(pDb->db, ms); 2332 break; 2333 } 2334 2335 /* 2336 ** $db total_changes 2337 ** 2338 ** Return the number of rows that were modified, inserted, or deleted 2339 ** since the database handle was created. 2340 */ 2341 case DB_TOTAL_CHANGES: { 2342 Tcl_Obj *pResult; 2343 if( objc!=2 ){ 2344 Tcl_WrongNumArgs(interp, 2, objv, ""); 2345 return TCL_ERROR; 2346 } 2347 pResult = Tcl_GetObjResult(interp); 2348 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db)); 2349 break; 2350 } 2351 2352 /* $db trace ?CALLBACK? 2353 ** 2354 ** Make arrangements to invoke the CALLBACK routine for each SQL statement 2355 ** that is executed. The text of the SQL is appended to CALLBACK before 2356 ** it is executed. 2357 */ 2358 case DB_TRACE: { 2359 if( objc>3 ){ 2360 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 2361 return TCL_ERROR; 2362 }else if( objc==2 ){ 2363 if( pDb->zTrace ){ 2364 Tcl_AppendResult(interp, pDb->zTrace, 0); 2365 } 2366 }else{ 2367 char *zTrace; 2368 int len; 2369 if( pDb->zTrace ){ 2370 Tcl_Free(pDb->zTrace); 2371 } 2372 zTrace = Tcl_GetStringFromObj(objv[2], &len); 2373 if( zTrace && len>0 ){ 2374 pDb->zTrace = Tcl_Alloc( len + 1 ); 2375 memcpy(pDb->zTrace, zTrace, len+1); 2376 }else{ 2377 pDb->zTrace = 0; 2378 } 2379 #ifndef SQLITE_OMIT_TRACE 2380 if( pDb->zTrace ){ 2381 pDb->interp = interp; 2382 sqlite3_trace(pDb->db, DbTraceHandler, pDb); 2383 }else{ 2384 sqlite3_trace(pDb->db, 0, 0); 2385 } 2386 #endif 2387 } 2388 break; 2389 } 2390 2391 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT 2392 ** 2393 ** Start a new transaction (if we are not already in the midst of a 2394 ** transaction) and execute the TCL script SCRIPT. After SCRIPT 2395 ** completes, either commit the transaction or roll it back if SCRIPT 2396 ** throws an exception. Or if no new transation was started, do nothing. 2397 ** pass the exception on up the stack. 2398 ** 2399 ** This command was inspired by Dave Thomas's talk on Ruby at the 2400 ** 2005 O'Reilly Open Source Convention (OSCON). 2401 */ 2402 case DB_TRANSACTION: { 2403 Tcl_Obj *pScript; 2404 const char *zBegin = "SAVEPOINT _tcl_transaction"; 2405 const char *zEnd; 2406 if( objc!=3 && objc!=4 ){ 2407 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); 2408 return TCL_ERROR; 2409 } 2410 2411 if( pDb->nTransaction ){ 2412 zBegin = "SAVEPOINT _tcl_transaction"; 2413 }else if( pDb->nTransaction==0 && objc==4 ){ 2414 static const char *TTYPE_strs[] = { 2415 "deferred", "exclusive", "immediate", 0 2416 }; 2417 enum TTYPE_enum { 2418 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE 2419 }; 2420 int ttype; 2421 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type", 2422 0, &ttype) ){ 2423 return TCL_ERROR; 2424 } 2425 switch( (enum TTYPE_enum)ttype ){ 2426 case TTYPE_DEFERRED: /* no-op */; break; 2427 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; 2428 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; 2429 } 2430 } 2431 pScript = objv[objc-1]; 2432 2433 pDb->disableAuth++; 2434 rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0); 2435 pDb->disableAuth--; 2436 if( rc!=SQLITE_OK ){ 2437 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); 2438 return TCL_ERROR; 2439 } 2440 2441 pDb->nTransaction++; 2442 rc = Tcl_EvalObjEx(interp, pScript, 0); 2443 pDb->nTransaction--; 2444 2445 if( rc!=TCL_ERROR ){ 2446 if( pDb->nTransaction ){ 2447 zEnd = "RELEASE _tcl_transaction"; 2448 }else{ 2449 zEnd = "COMMIT"; 2450 } 2451 }else{ 2452 if( pDb->nTransaction ){ 2453 zEnd = "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction"; 2454 }else{ 2455 zEnd = "ROLLBACK"; 2456 } 2457 } 2458 2459 pDb->disableAuth++; 2460 if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ 2461 /* This is a tricky scenario to handle. The most likely cause of an 2462 ** error is that the exec() above was an attempt to commit the 2463 ** top-level transaction that returned SQLITE_BUSY. Or, less likely, 2464 ** that an IO-error has occured. In either case, throw a Tcl exception 2465 ** and try to rollback the transaction. 2466 ** 2467 ** But it could also be that the user executed one or more BEGIN, 2468 ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing 2469 ** this method's logic. Not clear how this would be best handled. 2470 */ 2471 if( rc!=TCL_ERROR ){ 2472 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); 2473 rc = TCL_ERROR; 2474 } 2475 sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); 2476 } 2477 pDb->disableAuth--; 2478 2479 break; 2480 } 2481 2482 /* 2483 ** $db unlock_notify ?script? 2484 */ 2485 case DB_UNLOCK_NOTIFY: { 2486 #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY 2487 Tcl_AppendResult(interp, "unlock_notify not available in this build", 0); 2488 rc = TCL_ERROR; 2489 #else 2490 if( objc!=2 && objc!=3 ){ 2491 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); 2492 rc = TCL_ERROR; 2493 }else{ 2494 void (*xNotify)(void **, int) = 0; 2495 void *pNotifyArg = 0; 2496 2497 if( pDb->pUnlockNotify ){ 2498 Tcl_DecrRefCount(pDb->pUnlockNotify); 2499 pDb->pUnlockNotify = 0; 2500 } 2501 2502 if( objc==3 ){ 2503 xNotify = DbUnlockNotify; 2504 pNotifyArg = (void *)pDb; 2505 pDb->pUnlockNotify = objv[2]; 2506 Tcl_IncrRefCount(pDb->pUnlockNotify); 2507 } 2508 2509 if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){ 2510 Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0); 2511 rc = TCL_ERROR; 2512 } 2513 } 2514 #endif 2515 break; 2516 } 2517 2518 /* 2519 ** $db update_hook ?script? 2520 ** $db rollback_hook ?script? 2521 */ 2522 case DB_UPDATE_HOOK: 2523 case DB_ROLLBACK_HOOK: { 2524 2525 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on 2526 ** whether [$db update_hook] or [$db rollback_hook] was invoked. 2527 */ 2528 Tcl_Obj **ppHook; 2529 if( choice==DB_UPDATE_HOOK ){ 2530 ppHook = &pDb->pUpdateHook; 2531 }else{ 2532 ppHook = &pDb->pRollbackHook; 2533 } 2534 2535 if( objc!=2 && objc!=3 ){ 2536 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); 2537 return TCL_ERROR; 2538 } 2539 if( *ppHook ){ 2540 Tcl_SetObjResult(interp, *ppHook); 2541 if( objc==3 ){ 2542 Tcl_DecrRefCount(*ppHook); 2543 *ppHook = 0; 2544 } 2545 } 2546 if( objc==3 ){ 2547 assert( !(*ppHook) ); 2548 if( Tcl_GetCharLength(objv[2])>0 ){ 2549 *ppHook = objv[2]; 2550 Tcl_IncrRefCount(*ppHook); 2551 } 2552 } 2553 2554 sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); 2555 sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); 2556 2557 break; 2558 } 2559 2560 /* $db version 2561 ** 2562 ** Return the version string for this database. 2563 */ 2564 case DB_VERSION: { 2565 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC); 2566 break; 2567 } 2568 2569 2570 } /* End of the SWITCH statement */ 2571 return rc; 2572 } 2573 2574 /* 2575 ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? 2576 ** ?-create BOOLEAN? ?-nomutex BOOLEAN? 2577 ** 2578 ** This is the main Tcl command. When the "sqlite" Tcl command is 2579 ** invoked, this routine runs to process that command. 2580 ** 2581 ** The first argument, DBNAME, is an arbitrary name for a new 2582 ** database connection. This command creates a new command named 2583 ** DBNAME that is used to control that connection. The database 2584 ** connection is deleted when the DBNAME command is deleted. 2585 ** 2586 ** The second argument is the name of the database file. 2587 ** 2588 */ 2589 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 2590 SqliteDb *p; 2591 void *pKey = 0; 2592 int nKey = 0; 2593 const char *zArg; 2594 char *zErrMsg; 2595 int i; 2596 const char *zFile; 2597 const char *zVfs = 0; 2598 int flags; 2599 Tcl_DString translatedFilename; 2600 2601 /* In normal use, each TCL interpreter runs in a single thread. So 2602 ** by default, we can turn of mutexing on SQLite database connections. 2603 ** However, for testing purposes it is useful to have mutexes turned 2604 ** on. So, by default, mutexes default off. But if compiled with 2605 ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on. 2606 */ 2607 #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX 2608 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX; 2609 #else 2610 flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX; 2611 #endif 2612 2613 if( objc==2 ){ 2614 zArg = Tcl_GetStringFromObj(objv[1], 0); 2615 if( strcmp(zArg,"-version")==0 ){ 2616 Tcl_AppendResult(interp,sqlite3_version,0); 2617 return TCL_OK; 2618 } 2619 if( strcmp(zArg,"-has-codec")==0 ){ 2620 #ifdef SQLITE_HAS_CODEC 2621 Tcl_AppendResult(interp,"1",0); 2622 #else 2623 Tcl_AppendResult(interp,"0",0); 2624 #endif 2625 return TCL_OK; 2626 } 2627 } 2628 for(i=3; i+1<objc; i+=2){ 2629 zArg = Tcl_GetString(objv[i]); 2630 if( strcmp(zArg,"-key")==0 ){ 2631 pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey); 2632 }else if( strcmp(zArg, "-vfs")==0 ){ 2633 i++; 2634 zVfs = Tcl_GetString(objv[i]); 2635 }else if( strcmp(zArg, "-readonly")==0 ){ 2636 int b; 2637 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2638 if( b ){ 2639 flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE); 2640 flags |= SQLITE_OPEN_READONLY; 2641 }else{ 2642 flags &= ~SQLITE_OPEN_READONLY; 2643 flags |= SQLITE_OPEN_READWRITE; 2644 } 2645 }else if( strcmp(zArg, "-create")==0 ){ 2646 int b; 2647 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2648 if( b && (flags & SQLITE_OPEN_READONLY)==0 ){ 2649 flags |= SQLITE_OPEN_CREATE; 2650 }else{ 2651 flags &= ~SQLITE_OPEN_CREATE; 2652 } 2653 }else if( strcmp(zArg, "-nomutex")==0 ){ 2654 int b; 2655 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2656 if( b ){ 2657 flags |= SQLITE_OPEN_NOMUTEX; 2658 flags &= ~SQLITE_OPEN_FULLMUTEX; 2659 }else{ 2660 flags &= ~SQLITE_OPEN_NOMUTEX; 2661 } 2662 }else if( strcmp(zArg, "-fullmutex")==0 ){ 2663 int b; 2664 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2665 if( b ){ 2666 flags |= SQLITE_OPEN_FULLMUTEX; 2667 flags &= ~SQLITE_OPEN_NOMUTEX; 2668 }else{ 2669 flags &= ~SQLITE_OPEN_FULLMUTEX; 2670 } 2671 }else{ 2672 Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0); 2673 return TCL_ERROR; 2674 } 2675 } 2676 if( objc<3 || (objc&1)!=1 ){ 2677 Tcl_WrongNumArgs(interp, 1, objv, 2678 "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?" 2679 " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?" 2680 #ifdef SQLITE_HAS_CODEC 2681 " ?-key CODECKEY?" 2682 #endif 2683 ); 2684 return TCL_ERROR; 2685 } 2686 zErrMsg = 0; 2687 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) ); 2688 if( p==0 ){ 2689 Tcl_SetResult(interp, "malloc failed", TCL_STATIC); 2690 return TCL_ERROR; 2691 } 2692 memset(p, 0, sizeof(*p)); 2693 zFile = Tcl_GetStringFromObj(objv[2], 0); 2694 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename); 2695 sqlite3_open_v2(zFile, &p->db, flags, zVfs); 2696 Tcl_DStringFree(&translatedFilename); 2697 if( SQLITE_OK!=sqlite3_errcode(p->db) ){ 2698 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); 2699 sqlite3_close(p->db); 2700 p->db = 0; 2701 } 2702 #ifdef SQLITE_HAS_CODEC 2703 if( p->db ){ 2704 sqlite3_key(p->db, pKey, nKey); 2705 } 2706 #endif 2707 if( p->db==0 ){ 2708 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); 2709 Tcl_Free((char*)p); 2710 sqlite3_free(zErrMsg); 2711 return TCL_ERROR; 2712 } 2713 p->maxStmt = NUM_PREPARED_STMTS; 2714 p->interp = interp; 2715 zArg = Tcl_GetStringFromObj(objv[1], 0); 2716 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); 2717 return TCL_OK; 2718 } 2719 2720 /* 2721 ** Provide a dummy Tcl_InitStubs if we are using this as a static 2722 ** library. 2723 */ 2724 #ifndef USE_TCL_STUBS 2725 # undef Tcl_InitStubs 2726 # define Tcl_InitStubs(a,b,c) 2727 #endif 2728 2729 /* 2730 ** Make sure we have a PACKAGE_VERSION macro defined. This will be 2731 ** defined automatically by the TEA makefile. But other makefiles 2732 ** do not define it. 2733 */ 2734 #ifndef PACKAGE_VERSION 2735 # define PACKAGE_VERSION SQLITE_VERSION 2736 #endif 2737 2738 /* 2739 ** Initialize this module. 2740 ** 2741 ** This Tcl module contains only a single new Tcl command named "sqlite". 2742 ** (Hence there is no namespace. There is no point in using a namespace 2743 ** if the extension only supplies one new name!) The "sqlite" command is 2744 ** used to open a new SQLite database. See the DbMain() routine above 2745 ** for additional information. 2746 */ 2747 EXTERN int Sqlite3_Init(Tcl_Interp *interp){ 2748 Tcl_InitStubs(interp, "8.4", 0); 2749 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2750 Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION); 2751 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2752 Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION); 2753 return TCL_OK; 2754 } 2755 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2756 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2757 EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2758 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2759 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2760 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2761 EXTERN int Tclsqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;} 2762 2763 2764 #ifndef SQLITE_3_SUFFIX_ONLY 2765 EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2766 EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2767 EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2768 EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2769 EXTERN int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2770 EXTERN int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2771 EXTERN int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; } 2772 EXTERN int Tclsqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;} 2773 #endif 2774 2775 #ifdef TCLSH 2776 /***************************************************************************** 2777 ** The code that follows is used to build standalone TCL interpreters 2778 ** that are statically linked with SQLite. 2779 */ 2780 2781 /* 2782 ** If the macro TCLSH is one, then put in code this for the 2783 ** "main" routine that will initialize Tcl and take input from 2784 ** standard input, or if a file is named on the command line 2785 ** the TCL interpreter reads and evaluates that file. 2786 */ 2787 #if TCLSH==1 2788 static char zMainloop[] = 2789 "set line {}\n" 2790 "while {![eof stdin]} {\n" 2791 "if {$line!=\"\"} {\n" 2792 "puts -nonewline \"> \"\n" 2793 "} else {\n" 2794 "puts -nonewline \"% \"\n" 2795 "}\n" 2796 "flush stdout\n" 2797 "append line [gets stdin]\n" 2798 "if {[info complete $line]} {\n" 2799 "if {[catch {uplevel #0 $line} result]} {\n" 2800 "puts stderr \"Error: $result\"\n" 2801 "} elseif {$result!=\"\"} {\n" 2802 "puts $result\n" 2803 "}\n" 2804 "set line {}\n" 2805 "} else {\n" 2806 "append line \\n\n" 2807 "}\n" 2808 "}\n" 2809 ; 2810 #endif 2811 2812 /* 2813 ** If the macro TCLSH is two, then get the main loop code out of 2814 ** the separate file "spaceanal_tcl.h". 2815 */ 2816 #if TCLSH==2 2817 static char zMainloop[] = 2818 #include "spaceanal_tcl.h" 2819 ; 2820 #endif 2821 2822 #define TCLSH_MAIN main /* Needed to fake out mktclapp */ 2823 int TCLSH_MAIN(int argc, char **argv){ 2824 Tcl_Interp *interp; 2825 2826 /* Call sqlite3_shutdown() once before doing anything else. This is to 2827 ** test that sqlite3_shutdown() can be safely called by a process before 2828 ** sqlite3_initialize() is. */ 2829 sqlite3_shutdown(); 2830 2831 Tcl_FindExecutable(argv[0]); 2832 interp = Tcl_CreateInterp(); 2833 Sqlite3_Init(interp); 2834 #ifdef SQLITE_TEST 2835 { 2836 extern int Md5_Init(Tcl_Interp*); 2837 extern int Sqliteconfig_Init(Tcl_Interp*); 2838 extern int Sqlitetest1_Init(Tcl_Interp*); 2839 extern int Sqlitetest2_Init(Tcl_Interp*); 2840 extern int Sqlitetest3_Init(Tcl_Interp*); 2841 extern int Sqlitetest4_Init(Tcl_Interp*); 2842 extern int Sqlitetest5_Init(Tcl_Interp*); 2843 extern int Sqlitetest6_Init(Tcl_Interp*); 2844 extern int Sqlitetest7_Init(Tcl_Interp*); 2845 extern int Sqlitetest8_Init(Tcl_Interp*); 2846 extern int Sqlitetest9_Init(Tcl_Interp*); 2847 extern int Sqlitetestasync_Init(Tcl_Interp*); 2848 extern int Sqlitetest_autoext_Init(Tcl_Interp*); 2849 extern int Sqlitetest_func_Init(Tcl_Interp*); 2850 extern int Sqlitetest_hexio_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_malloc_Init(interp); 2877 Sqlitetest_mutex_Init(interp); 2878 Sqlitetestschema_Init(interp); 2879 Sqlitetesttclvar_Init(interp); 2880 SqlitetestThread_Init(interp); 2881 SqlitetestOnefile_Init(interp); 2882 SqlitetestOsinst_Init(interp); 2883 Sqlitetestbackup_Init(interp); 2884 2885 #ifdef SQLITE_SSE 2886 Sqlitetestsse_Init(interp); 2887 #endif 2888 } 2889 #endif 2890 if( argc>=2 || TCLSH==2 ){ 2891 int i; 2892 char zArgc[32]; 2893 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH)); 2894 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY); 2895 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); 2896 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); 2897 for(i=3-TCLSH; i<argc; i++){ 2898 Tcl_SetVar(interp, "argv", argv[i], 2899 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); 2900 } 2901 if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ 2902 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); 2903 if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp); 2904 fprintf(stderr,"%s: %s\n", *argv, zInfo); 2905 return 1; 2906 } 2907 } 2908 if( argc<=1 || TCLSH==2 ){ 2909 Tcl_GlobalEval(interp, zMainloop); 2910 } 2911 return 0; 2912 } 2913 #endif /* TCLSH */ 2914