/***********************************************************************/ /* This program is meant to run as an object. */ /* It is a simple program to demonstrate: */ /* -- "Private" attributes available to it */ /* -- "Public" methods available to other programs. */ /* -- A good template for future objects with Constructor and */ /* Destructor routines. */ /***********************************************************************/ /***********************************************************************/ /* obj_query.p */ /* An object to aid with managing dynamic queries. */ /***********************************************************************/ /*{objmgr.i}*/ /* May be deleted if not using object manager */ FUNCTION cGetAttr RETURNS CHARACTER (INPUT cAttrName AS CHARACTER) FORWARD. /* ----------------------- Begin Attributes List ----------------------*/ /* Example attribute specific to the object */ /* Used for object management */ DEFINE VARIABLE cgObjName as character NO-UNDO. /* Used for object implementation */ DEFINE TEMP-TABLE ttBufferList FIELD BufferName AS CHARACTER FIELD BufferTable AS CHARACTER FIELD BufferHandle AS HANDLE. DEFINE VARIABLE hTheQuery AS HANDLE NO-UNDO. /* ------------------------- End Attributes List ----------------------*/ /* -------------------------- Begin Methods List ----------------------*/ /***********************************************************************/ /* This is the "destructor" for the routine. It should be called be */ /* fore deleting the handle to the instance of this object. */ /***********************************************************************/ PROCEDURE Destroy: RUN CloseQuery IN THIS-PROCEDURE. RUN ClearBuffer IN THIS-PROCEDURE. END. /***********************************************************************/ /* If other "constructors" are needed, they can be put in. This one */ /* is called Init. Unlike C++, it will need to be run manually. */ /* If you are using ObjMgr.i, it will be run automatically. */ /* If you need to make other Inits, place them here and name beginning */ /* "Init" : InitByRowID or InitBySalesOrderNumber. */ /***********************************************************************/ PROCEDURE Init: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. ASSIGN cgObjName = cName. RUN SetError IN THIS-PROCEDURE ("000", "Init"). RUN ClearBuffer IN THIS-PROCEDURE. RUN SetAttr IN THIS-PROCEDURE ("Version", "1.0"). END. /***********************************************************************/ /* All procedures need a way to describe their errors back to the cal- */ /* ler. */ /***********************************************************************/ PROCEDURE GetError: DEFINE OUTPUT PARAMETER cErrCode AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cErrMsg AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cErrMethod AS CHARACTER NO-UNDO. ASSIGN cErrCode = cGetAttr("ErrCode") cErrMsg = cGetAttr("ErrMsg") cErrMethod = cGetAttr("ErrMethod"). END. /* PROCEDURE GetError */ /***********************************************************************/ /* This is the central point where internal procedures can communicate */ /* their problems to the procedure as a whole. */ /* It's main purpose is to convert codes into human readable form in */ /* cgObjErrMsg as well as populate the procedures globally available */ /* vars. */ /***********************************************************************/ PROCEDURE SetError: DEFINE INPUT PARAMETER cErrorCode AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cMethodName AS CHARACTER NO-UNDO. CASE cErrorCode: WHEN "000" THEN DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", "No Error"). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. WHEN "001" THEN DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", "No Such Attribute"). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. WHEN "100" THEN DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", "PREPARE Failed"). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. WHEN "101" THEN DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", "OPEN Failed"). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. WHEN "103" THEN DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", "No Such Buffer"). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. OTHERWISE DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", ?). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. END. /* CASE */ END. /* PROCEDURE SetError */ /***********************************************************************/ /* These are methods to perform activities on the data controlled by */ /* the object. */ /* Attributes are actually stored in a temp-table, that way we can add */ /* new ones easily, and not need to create more Set/Get routines for */ /* for each attribute. The bad news is, we need to cast to and from */ /* character for the data to pass back and fourth. If this is a pron- */ /* lem, then create some Set/Get routines for those values. */ /***********************************************************************/ DEFINE TEMP-TABLE ttAttributes FIELD AttrName AS CHARACTER FIELD AttrValue AS CHARACTER INDEX key1 AttrName ASCENDING. /***********************************************************************/ /* We don't make this a function, because we need to FORWARD declare */ /* in the code using this object, and this name is going to be pret- */ /* ty popular causing conflict with other objects with a GetAttr. */ /***********************************************************************/ PROCEDURE GetAttr: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cValue AS CHARACTER NO-UNDO. FIND ttAttributes NO-LOCK WHERE ttAttributes.AttrName = cName NO-ERROR. IF NOT AVAILABLE ttAttributes THEN DO: /*********************************************************/ /* Note that sometimes it is OK for an attribute to be ? */ /* so be sure to remember to check the error if the at- */ /* tribute wasn't found or really is ?. Sometimes it */ /* it works out it does not matter, sometimes it does */ /* matter. */ /*********************************************************/ RUN SetError IN THIS-PROCEDURE ("001", "GetAttr"). ASSIGN cValue = ?. RETURN. END. /* IF NOT AVAILABLE ttAttributes */ ASSIGN cValue = ttAttributes.AttrValue. END. /* PROCEDURE GetAttr */ /***********************************************************************/ /* However it IS useful to have a GetAttr function for use in THIS- */ /* PROCEDURE within the internal procedures available. */ /***********************************************************************/ FUNCTION cGetAttr RETURNS CHARACTER (INPUT cAttrName AS CHARACTER): DEFINE VARIABLE cAttrValue AS CHARACTER NO-UNDO. RUN GetAttr IN THIS-PROCEDURE (INPUT cAttrName, OUTPUT cAttrValue). RETURN cAttrValue. END. /* FUNCTION cGetAttr() */ /***********************************************************************/ /* If the attribute already exists, we overwrite, not error out... */ /***********************************************************************/ PROCEDURE SetAttr: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cValue AS CHARACTER NO-UNDO. FIND ttAttributes NO-LOCK WHERE ttAttributes.AttrName = cName NO-ERROR. IF NOT AVAILABLE ttAttributes THEN CREATE ttAttributes. ASSIGN ttAttributes.AttrName = cName ttAttributes.AttrValue = cValue. /* Some attributes are dependent on other attributes, handle those */ /* here. */ RUN DependentAttr (cName, cValue). END. /* PROCEDURE SetAttr */ /***********************************************************************/ /* Some attributes are dependent on the values of other attributes. */ /* We keep them in sync with this code here. */ /***********************************************************************/ PROCEDURE DependentAttr: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cValue AS CHARACTER NO-UNDO. RUN SetLastUsed IN THIS-PROCEDURE. CASE cName: WHEN "BufferNames" THEN RUN SetBufferNames IN THIS-PROCEDURE (INPUT cValue). END. END. /* PROCEDURE DependentAttr */ /***********************************************************************/ /* This is a way to quickly transfer record information into attri- */ /* butes. The attribute name is tablename_fieldname. */ /* Example Use: */ /* FIND FIRST Person NO-LOCK. */ /* ASSIGN hBuffer = BUFFER Person:Handle. */ /* RUN Record2Attr (hBuffer). */ /***********************************************************************/ PROCEDURE Record2Attr: DEFINE INPUT PARAMETER hBuffer AS HANDLE NO-UNDO. DEFINE VARIABLE hField AS HANDLE NO-UNDO. DEFINE VARIABLE i AS INTEGER NO-UNDO. DO i = 1 TO hBuffer:Num-Fields: ASSIGN hField = hBuffer:Buffer-Field(i). RUN SetAttr IN THIS-PROCEDURE (hBuffer:Name + "_" + hField:Name, hField:String-Value). END. END. /***********************************************************************/ /* Scan the attributes table for entries beginning with the table name */ /* and apply their values to the field named in the second part of the */ /* attribute name. */ /* Note this doesn't manage multiple buffers of the same name very */ /* well. If you need n records from the same table, name the buffers */ /* seperately. */ /***********************************************************************/ PROCEDURE Attr2Record: DEFINE INPUT PARAMETER hBuffer AS HANDLE NO-UNDO. DEFINE VARIABLE hField AS HANDLE NO-UNDO. DEFINE VARIABLE cFieldName AS CHARACTER NO-UNDO. FOR EACH ttAttributes NO-LOCK WHERE ttAttributes.AttrName BEGINS hBuffer:Name + "_": /*****************************************************************/ /* Luckily, it appears that buffer-value types automatically... */ /* It will puke on bad data sent - such as text for an int, etc. */ /*****************************************************************/ ASSIGN hfield = hBuffer:Buffer-Field(ENTRY(2, ttAttributes.AttrName, "_")) hfield:Buffer-Value = ttAttributes.AttrValue. END. /* FOR EACH ttAttributes */ END. /* PROCEDURE Attr2Record */ /***********************************************************************/ /* Useful for debugging. Note we output to a file so we don't get any */ /* wrong display device type errors when the r-code is shared between */ /* different interfaces. */ /***********************************************************************/ PROCEDURE AttrDebug: DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO. OUTPUT TO VALUE(cFileName). FOR EACH ttAttributes NO-LOCK: PUT UNFORMATTED ttAttributes.AttrName "=" ttAttributes.AttrValue SKIP. END. /* FOR EACH ttAttributes */ OUTPUT CLOSE. END. /* PROCEDURE AttrDebug */ /***********************************************************************/ /* Clear out all attributes that have been set. It is better to set */ /* an attribute to ? and code for that; but sometimes one needs this. */ /***********************************************************************/ PROCEDURE ClearAttr: FOR EACH ttAttributes: DELETE ttAttributes. END. /* FOR EACH ttAttributes */ END. /* PROCEDURE ClearAttr */ /* ------------------------ Specialized Methods -----------------------*/ /***********************************************************************/ /* Create some buffers we will associate to the query later on. */ /* List should be like "Doctor FOR Person,Customer FOR Person" etc. */ /* Then QueryText = "FOR EACH Doctor NO-LOCK WHERE ... " to use */ /* buffers. */ /***********************************************************************/ PROCEDURE SetBufferNames: DEFINE INPUT PARAMETER cBufferList AS CHARACTER NO-UNDO. DEFINE VARIABLE iIter AS INTEGER NO-UNDO. DEFINE VARIABLE iMaxIter AS INTEGER NO-UNDO. DEFINE VARIABLE cCurrDefinition AS CHARACTER NO-UNDO. DEFINE VARIABLE cCurrBufferName AS CHARACTER NO-UNDO. DEFINE VARIABLE cCurrBufferTable AS CHARACTER NO-UNDO. DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO. RUN ClearBuffers IN THIS-PROCEDURE. ASSIGN iMaxIter = NUM-ENTRIES (cBufferList). DO iIter = 1 TO iMaxIter: ASSIGN cCurrDefinition = ENTRY(iIter, cBufferList) cCurrBufferName = ENTRY(1, cCurrDefinition, " ") cCurrBufferTable = ENTRY(3, cCurrDefinition, " "). CREATE ttBufferList. ASSIGN ttBufferList.BufferName = cCurrBufferName ttBufferList.BufferTable = cCurrBufferTable. CREATE BUFFER hBuffer FOR TABLE cCurrBufferTable BUFFER-NAME cCurrBufferName. ASSIGN ttBufferList.BufferHandle = hBuffer. END. /* DO iIter = 1 TO iMaxIter */ END. /* PROCEDURE SetBufferNames */ /***********************************************************************/ /* Delete our buffer list and any memory associated to the buffer. */ /***********************************************************************/ PROCEDURE ClearBuffers: FOR EACH ttBufferList: DELETE OBJECT ttBufferList.BufferHandle. DELETE ttBufferList. END. /* FOR EACH ttBufferList */ END. /* PROCEDURE ClearBuffers */ /***********************************************************************/ /* Open up a query as given by attribute QueryText */ /***********************************************************************/ PROCEDURE OpenQuery: DEFINE VARIABLE lStatusFlag AS LOGICAL NO-UNDO. DEFINE VARIABLE cErrorInfo AS CHARACTER NO-UNDO. DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO. DEFINE VARIABLE i AS INTEGER NO-UNDO. CREATE QUERY hTheQuery. /* Attach our buffers to the query so something is there */ FOR EACH ttBufferList: hTheQuery:ADD-BUFFER(ttBufferList.BufferHandle). END. /* FOR EACH ttBufferList*/ RUN SetAttr IN THIS-PROCEDURE ("OpenErrorData", ""). /* Now that we have the data structures ready, call out to */ /* to the DB. */ ASSIGN lStatusFlag = hTheQuery:QUERY-PREPARE(cGetAttr("QueryText")). IF lStatusFlag = FALSE THEN DO: RUN SetError IN THIS-PROCEDURE ("100", PROGRAM-NAME(1)). RETURN. END. ASSIGN lStatusFlag = hTheQuery:QUERY-OPEN(). IF lStatusFlag = FALSE THEN DO: RUN SetError IN THIS-PROCEDURE ("101", PROGRAM-NAME(1)). ASSIGN cErrorInfo = "Open FAILED!~n" + "Date: " + STRING(TODAY) + " " + STRING(TIME, "HH:MM:SS") + "~n" + "cBufferList: " + cGetAttr("BufferNames") + "~n". /* Begin Used for debugging */ REPEAT i = 1 TO hTheQuery:NUM-BUFFERS: hBuffer = hTheQuery:GET-BUFFER-HANDLE(i). ASSIGN cErrorInfo = cErrorInfo + "Query Has Buffer: " + hBuffer:NAME + "~n". END. RUN SetAttr IN THIS-PROCEDURE ("OpenErrorData", cErrorInfo). END. /* IF lStatusFlag = FALSE */ END. /* PROCEDURE OpenQuery */ /***********************************************************************/ /* Close the query and delete the memory allocated to the object. */ /***********************************************************************/ PROCEDURE CloseQuery: DELETE OBJECT hTheQuery. END. /* PROCEDURE CloseQuery */ /***********************************************************************/ /* Navigate the result set of the query. */ /***********************************************************************/ PROCEDURE MoveCursor: DEFINE INPUT PARAMETER cDirection AS CHARACTER NO-UNDO. CASE cDirection: WHEN "NEXT" THEN hTheQuery:GET-NEXT. WHEN "PREV" THEN hTheQuery:GET-PREV. WHEN "FIRST" THEN hTheQuery:GET-FIRST. WHEN "LAST" THEN hTheQuery:GET-LAST. END. /* CASE */ RUN SetLastUsed IN THIS-PROCEDURE. END. /* PROCEDURE MoveCursor */ /***********************************************************************/ /* Pull back a buffer handle from the result set. One can then do a */ /* Find Buffer NO-LOCK WHERE ROWID(Buffer) = h:ROWID NO-ERROR to work */ /* with static code. */ /***********************************************************************/ PROCEDURE BufferHandle: DEFINE INPUT PARAMETER cBufferName AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER hOut AS HANDLE NO-UNDO. FIND ttBufferList NO-LOCK WHERE ttBufferList.BufferName = cBufferName NO-ERROR. IF AVAILABLE ttBufferList THEN DO: ASSIGN hOut = ttBufferList.BufferHandle. RETURN. END. /* IF AVAILABLE ttBufferList */ RUN SetError IN THIS-PROCEDURE ("103", PROGRAM-NAME(1)). END. /* PROCEDURE BufferHandle */ /***********************************************************************/ /* If you have no need for the buffer, you can pull back values in */ /* Table.Field format here and get the value as a character. */ /***********************************************************************/ PROCEDURE GetField: DEFINE INPUT PARAMETER cBufferFieldName AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cOut AS CHARACTER NO-UNDO. DEFINE VARIABLE hOut AS HANDLE NO-UNDO. DEFINE VARIABLE hOutFld AS HANDLE NO-UNDO. DEFINE VARIABLE cTableName AS CHARACTER NO-UNDO. DEFINE VARIABLE cFieldName AS CHARACTER NO-UNDO. ASSIGN cTableName = ENTRY(1, cBufferFieldName, ".") cFieldName = ENTRY(2, cBufferFieldName, "."). FIND ttBufferList NO-LOCK WHERE ttBufferList.BufferName = cTableName NO-ERROR. IF NOT AVAILABLE ttBufferList THEN DO: RUN SetError IN THIS-PROCEDURE ("103", PROGRAM-NAME(1)). RETURN. END. /* IF NOT AVAILABLE ttBufferList */ ASSIGN hOut = ttBufferList.BufferHandle. ASSIGN hOutFld = hOut:BUFFER-FIELD(cFieldName). ASSIGN cOut = hOutFld:BUFFER-VALUE. END. /* PROCEDURE GetField */ /***********************************************************************/ /* Number of rows in the result set. */ /***********************************************************************/ PROCEDURE NumRows: DEFINE OUTPUT PARAMETER iRowCount AS INTEGER NO-UNDO. END. /* PROCEDURE NumRows */ /***********************************************************************/ /* To help with purging the persistent object IN CASE we loose it in */ /* Webspeed. We can walk the list of persistent procedures in the */ /* session and delete based on the last time used. */ /***********************************************************************/ PROCEDURE SetLastUsed: RUN SetAttr IN THIS-PROCEDURE ("LastDate", STRING(TODAY)). RUN SetAttr IN THIS-PROCEDURE ("LastTime", STRING(TIME)). END. /* -------------------------- End Methods List ------------------------*/