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