| /* |
| ** 2010 August 28 |
| ** |
| ** The author disclaims copyright to this source code. In place of |
| ** a legal notice, here is a blessing: |
| ** |
| ** May you do good and not evil. |
| ** May you find forgiveness for yourself and forgive others. |
| ** May you share freely, never taking more than you give. |
| ** |
| ************************************************************************* |
| ** Code for testing all sorts of SQLite interfaces. This code |
| ** is not included in the SQLite library. |
| */ |
| |
| #include "sqlite3.h" |
| #if defined(INCLUDE_SQLITE_TCL_H) |
| # include "sqlite_tcl.h" |
| #else |
| # include "tcl.h" |
| #endif |
| |
| /* Solely for the UNUSED_PARAMETER() macro. */ |
| #include "sqliteInt.h" |
| |
| #ifdef SQLITE_ENABLE_RTREE |
| |
| typedef struct BoxGeomCtx BoxGeomCtx; |
| struct BoxGeomCtx { |
| Tcl_Interp *interp; |
| Tcl_Obj *pScript; |
| }; |
| |
| typedef struct BoxQueryCtx BoxQueryCtx; |
| struct BoxQueryCtx { |
| Tcl_Interp *interp; |
| Tcl_Obj *pScript; |
| }; |
| |
| static void testDelUser(void *pCtx){ |
| BoxGeomCtx *p = (BoxGeomCtx*)pCtx; |
| Tcl_EvalObjEx(p->interp, p->pScript, 0); |
| Tcl_DecrRefCount(p->pScript); |
| sqlite3_free(p); |
| } |
| |
| static int invokeTclGeomCb( |
| const char *zName, |
| sqlite3_rtree_geometry *p, |
| int nCoord, |
| sqlite3_rtree_dbl *aCoord |
| ){ |
| int rc = SQLITE_OK; |
| if( p->pContext ){ |
| char aPtr[64]; |
| BoxGeomCtx *pCtx = (BoxGeomCtx*)p->pContext; |
| Tcl_Interp *interp = pCtx->interp; |
| Tcl_Obj *pScript = 0; |
| Tcl_Obj *pParam = 0; |
| Tcl_Obj *pCoord = 0; |
| int ii; |
| Tcl_Obj *pRes; |
| |
| |
| pScript = Tcl_DuplicateObj(pCtx->pScript); |
| Tcl_IncrRefCount(pScript); |
| Tcl_ListObjAppendElement(interp, pScript, Tcl_NewStringObj(zName,-1)); |
| |
| sqlite3_snprintf(sizeof(aPtr)-1, aPtr, "%p", (void*)p->pContext); |
| Tcl_ListObjAppendElement(interp, pScript, Tcl_NewStringObj(aPtr,-1)); |
| |
| pParam = Tcl_NewObj(); |
| for(ii=0; ii<p->nParam; ii++){ |
| Tcl_ListObjAppendElement( |
| interp, pParam, Tcl_NewDoubleObj(p->aParam[ii]) |
| ); |
| } |
| Tcl_ListObjAppendElement(interp, pScript, pParam); |
| |
| pCoord = Tcl_NewObj(); |
| for(ii=0; ii<nCoord; ii++){ |
| Tcl_ListObjAppendElement(interp, pCoord, Tcl_NewDoubleObj(aCoord[ii])); |
| } |
| Tcl_ListObjAppendElement(interp, pScript, pCoord); |
| |
| sqlite3_snprintf(sizeof(aPtr)-1, aPtr, "%p", (void*)p); |
| Tcl_ListObjAppendElement(interp, pScript, Tcl_NewStringObj(aPtr,-1)); |
| |
| rc = Tcl_EvalObjEx(interp, pScript, 0); |
| if( rc!=TCL_OK ){ |
| rc = SQLITE_ERROR; |
| }else{ |
| int nObj = 0; |
| Tcl_Obj **aObj = 0; |
| |
| pRes = Tcl_GetObjResult(interp); |
| if( Tcl_ListObjGetElements(interp, pRes, &nObj, &aObj) ) return TCL_ERROR; |
| if( nObj>0 ){ |
| const char *zCmd = Tcl_GetString(aObj[0]); |
| if( 0==sqlite3_stricmp(zCmd, "zero") ){ |
| p->aParam[0] = 0.0; |
| p->nParam = 1; |
| } |
| else if( 0==sqlite3_stricmp(zCmd, "user") ){ |
| if( p->pUser || p->xDelUser ){ |
| rc = SQLITE_ERROR; |
| }else{ |
| BoxGeomCtx *pBGCtx = sqlite3_malloc(sizeof(BoxGeomCtx)); |
| if( pBGCtx==0 ){ |
| rc = SQLITE_NOMEM; |
| }else{ |
| pBGCtx->interp = interp; |
| pBGCtx->pScript = Tcl_DuplicateObj(pRes); |
| Tcl_IncrRefCount(pBGCtx->pScript); |
| Tcl_ListObjReplace(interp, pBGCtx->pScript, 0, 1, 0, 0); |
| p->pUser = (void*)pBGCtx; |
| p->xDelUser = testDelUser; |
| } |
| } |
| } |
| else if( 0==sqlite3_stricmp(zCmd, "user_is_zero") ){ |
| if( p->pUser || p->xDelUser ) rc = SQLITE_ERROR; |
| } |
| } |
| } |
| } |
| return rc; |
| } |
| |
| /* |
| # EVIDENCE-OF: R-00693-36727 The legacy xGeom callback is invoked with |
| # four arguments. |
| |
| # EVIDENCE-OF: R-50437-53270 The first argument is a pointer to an |
| # sqlite3_rtree_geometry structure which provides information about how |
| # the SQL function was invoked. |
| |
| # EVIDENCE-OF: R-00090-24248 The third argument, aCoord[], is an array |
| # of nCoord coordinates that defines a bounding box to be tested. |
| |
| # EVIDENCE-OF: R-28207-40885 The last argument is a pointer into which |
| # the callback result should be written. |
| |
| */ |
| static int box_geom( |
| sqlite3_rtree_geometry *p, /* R-50437-53270 */ |
| int nCoord, /* R-02424-24769 */ |
| sqlite3_rtree_dbl *aCoord, /* R-00090-24248 */ |
| int *pRes /* R-28207-40885 */ |
| ){ |
| int ii; |
| |
| if( p->nParam!=nCoord ){ |
| invokeTclGeomCb("box", p, nCoord, aCoord); |
| return SQLITE_ERROR; |
| } |
| if( invokeTclGeomCb("box", p, nCoord, aCoord) ) return SQLITE_ERROR; |
| |
| for(ii=0; ii<nCoord; ii+=2){ |
| if( aCoord[ii]>p->aParam[ii+1] || aCoord[ii+1]<p->aParam[ii] ){ |
| /* R-28207-40885 */ |
| *pRes = 0; |
| return SQLITE_OK; |
| } |
| } |
| |
| /* R-28207-40885 */ |
| *pRes = 1; |
| |
| return SQLITE_OK; |
| } |
| |
| static int SQLITE_TCLAPI register_box_geom( |
| void * clientData, |
| Tcl_Interp *interp, |
| int objc, |
| Tcl_Obj *CONST objv[] |
| ){ |
| extern int getDbPointer(Tcl_Interp*, const char*, sqlite3**); |
| extern const char *sqlite3ErrName(int); |
| sqlite3 *db; |
| BoxGeomCtx *pCtx; |
| char aPtr[64]; |
| |
| if( objc!=3 ){ |
| Tcl_WrongNumArgs(interp, 1, objv, "DB SCRIPT"); |
| return TCL_ERROR; |
| } |
| if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR; |
| |
| pCtx = (BoxGeomCtx*)ckalloc(sizeof(BoxGeomCtx*)); |
| pCtx->interp = interp; |
| pCtx->pScript = Tcl_DuplicateObj(objv[2]); |
| Tcl_IncrRefCount(pCtx->pScript); |
| |
| sqlite3_rtree_geometry_callback(db, "box", box_geom, (void*)pCtx); |
| |
| sqlite3_snprintf(64, aPtr, "%p", (void*)pCtx); |
| Tcl_SetObjResult(interp, Tcl_NewStringObj(aPtr, -1)); |
| return TCL_OK; |
| } |
| |
| static int box_query(sqlite3_rtree_query_info *pInfo){ |
| const char *azParentWithin[] = {"not", "partly", "fully", 0}; |
| BoxQueryCtx *pCtx = (BoxQueryCtx*)pInfo->pContext; |
| Tcl_Interp *interp = pCtx->interp; |
| Tcl_Obj *pEval; |
| Tcl_Obj *pArg; |
| Tcl_Obj *pTmp = 0; |
| int rc; |
| int ii; |
| |
| pEval = Tcl_DuplicateObj(pCtx->pScript); |
| Tcl_IncrRefCount(pEval); |
| pArg = Tcl_NewObj(); |
| Tcl_IncrRefCount(pArg); |
| |
| /* aParam[] */ |
| pTmp = Tcl_NewObj(); |
| Tcl_IncrRefCount(pTmp); |
| for(ii=0; ii<pInfo->nParam; ii++){ |
| Tcl_Obj *p = Tcl_NewDoubleObj(pInfo->aParam[ii]); |
| Tcl_ListObjAppendElement(interp, pTmp, p); |
| } |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("aParam", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, pTmp); |
| Tcl_DecrRefCount(pTmp); |
| |
| /* aCoord[] */ |
| pTmp = Tcl_NewObj(); |
| Tcl_IncrRefCount(pTmp); |
| for(ii=0; ii<pInfo->nCoord; ii++){ |
| Tcl_Obj *p = Tcl_NewDoubleObj(pInfo->aCoord[ii]); |
| Tcl_ListObjAppendElement(interp, pTmp, p); |
| } |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("aCoord", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, pTmp); |
| Tcl_DecrRefCount(pTmp); |
| |
| /* anQueue[] */ |
| pTmp = Tcl_NewObj(); |
| Tcl_IncrRefCount(pTmp); |
| for(ii=0; ii<=pInfo->mxLevel; ii++){ |
| Tcl_Obj *p = Tcl_NewIntObj((int)pInfo->anQueue[ii]); |
| Tcl_ListObjAppendElement(interp, pTmp, p); |
| } |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("anQueue", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, pTmp); |
| Tcl_DecrRefCount(pTmp); |
| |
| /* iLevel */ |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("iLevel", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewIntObj(pInfo->iLevel)); |
| |
| /* mxLevel */ |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("mxLevel", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewIntObj(pInfo->mxLevel)); |
| |
| /* iRowid */ |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("iRowid", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewWideIntObj(pInfo->iRowid)); |
| |
| /* rParentScore */ |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("rParentScore", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewDoubleObj(pInfo->rParentScore)); |
| |
| /* eParentWithin */ |
| assert( pInfo->eParentWithin==0 |
| || pInfo->eParentWithin==1 |
| || pInfo->eParentWithin==2 |
| ); |
| Tcl_ListObjAppendElement(interp, pArg, Tcl_NewStringObj("eParentWithin", -1)); |
| Tcl_ListObjAppendElement(interp, pArg, |
| Tcl_NewStringObj(azParentWithin[pInfo->eParentWithin], -1) |
| ); |
| |
| Tcl_ListObjAppendElement(interp, pEval, pArg); |
| rc = Tcl_EvalObjEx(interp, pEval, 0) ? SQLITE_ERROR : SQLITE_OK; |
| |
| if( rc==SQLITE_OK ){ |
| double rScore = 0.0; |
| int nObj = 0; |
| int eP = 0; |
| Tcl_Obj **aObj = 0; |
| Tcl_Obj *pRes = Tcl_GetObjResult(interp); |
| |
| if( Tcl_ListObjGetElements(interp, pRes, &nObj, &aObj) |
| || nObj!=2 |
| || Tcl_GetDoubleFromObj(interp, aObj[1], &rScore) |
| || Tcl_GetIndexFromObj(interp, aObj[0], azParentWithin, "value", 0, &eP) |
| ){ |
| rc = SQLITE_ERROR; |
| }else{ |
| pInfo->rScore = rScore; |
| pInfo->eParentWithin = eP; |
| } |
| } |
| |
| Tcl_DecrRefCount(pArg); |
| Tcl_DecrRefCount(pEval); |
| return rc; |
| } |
| |
| static void box_query_destroy(void *p){ |
| BoxQueryCtx *pCtx = (BoxQueryCtx*)p; |
| Tcl_DecrRefCount(pCtx->pScript); |
| ckfree((char*)pCtx); |
| } |
| |
| static int SQLITE_TCLAPI register_box_query( |
| void * clientData, |
| Tcl_Interp *interp, |
| int objc, |
| Tcl_Obj *CONST objv[] |
| ){ |
| extern int getDbPointer(Tcl_Interp*, const char*, sqlite3**); |
| extern const char *sqlite3ErrName(int); |
| sqlite3 *db; |
| BoxQueryCtx *pCtx; |
| |
| if( objc!=3 ){ |
| Tcl_WrongNumArgs(interp, 1, objv, "DB SCRIPT"); |
| return TCL_ERROR; |
| } |
| if( getDbPointer(interp, Tcl_GetString(objv[1]), &db) ) return TCL_ERROR; |
| |
| pCtx = (BoxQueryCtx*)ckalloc(sizeof(BoxQueryCtx)); |
| pCtx->interp = interp; |
| pCtx->pScript = Tcl_DuplicateObj(objv[2]); |
| Tcl_IncrRefCount(pCtx->pScript); |
| |
| sqlite3_rtree_query_callback( |
| db, "qbox", box_query, (void*)pCtx, box_query_destroy |
| ); |
| |
| Tcl_ResetResult(interp); |
| return TCL_OK; |
| } |
| #endif /* SQLITE_ENABLE_RTREE */ |
| |
| |
| int Sqlitetestrtreedoc_Init(Tcl_Interp *interp){ |
| #ifdef SQLITE_ENABLE_RTREE |
| Tcl_CreateObjCommand(interp, "register_box_geom", register_box_geom, 0, 0); |
| Tcl_CreateObjCommand(interp, "register_box_query", register_box_query, 0, 0); |
| #endif /* SQLITE_ENABLE_RTREE */ |
| return TCL_OK; |
| } |