The following sample program, SYCCSAU2, establishes a long-running conversational transaction which returns data to the client, then waits for client requests via the TDGETREQ interface. The purpose of this sample is to demonstrate the handling of cursor commands. This sample processes an Embedded SQL™/C Open Client RPC, syu2.c, which is included on the TRS tape. The SYCCSAU2 sample program is included on the Open ServerConnect API tape.
This sample program does not use any table, the data used by the cursor commands is hard-coded in the program.
*@(#) syccsau2.cobol 1.1 4/26/96 */
IDENTIFICATION DIVISION.
PROGRAM-ID. SYCCSAU2.
****** SYCCSAU2 - SAMPLE LONG-RUNNING CURSOR transaction program ***
*
* TRANID: SYU2
* PROGRAM: SYCCSAU2
* PLAN NAME: n/a
* FILES: n/a
* TABLES: n/a
*
* This program establishes a long-running "conversational"
* transaction which returns data to the client then waits for
* client requests via the TDGETREQ interface.
* This version of the program is built to use the open server
* cursor commands which are introduced on OS 3.1 and netgateways
* 3.0.1
*
* The following Open Server Library calls are used:
*
* TDINIT initializes the TDS environment
* TDACCEPT accept a request from a client
* TDCURPRO cursor processing command
* TDESCRIB describe a column in a result row
* TDFREE free the TDPROC structure
* TDGETREQ get the next cursor request
* TDINFPRM retrieve information about a RPC parameter
* TDINIT initialize the TDS environment
* TDRCVPRM retrieve the data from a RPC parameter
* TDRCVSQL get SQL next
* TDRESULT describe the next object from a client
* TDSNDDON send result completion indication to client
* TDSNDROW send a row of data to the requesting client
* TDNUMPRM get number of cursor parameters
*
* Change Activity:
* 04/13 J.A.- code to handle cursor support select support
* 04/17 J.A.- added code to handle update and delete from cursor
*******************************************************************
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*----------------------------------------------------------------
* Work variables
*----------------------------------------------------------------
77 COL-20 PIC S9(9) COMP VALUE +20.
77 COL2-LNG PIC S9(9) COMP VALUE +4.
77 COL-COUNT PIC S9(9) COMP VALUE +1.
77 COLUMN-NAME PIC X(4) VALUE 'COLS'.
77 COLUMN-NAME-LEN PIC S9(9) COMP VALUE +4.
* Gateway Library interface variables
77 GWL-INIT-HANDLE POINTER.
77 GWL-PROC POINTER.
77 GWL-RC PIC S9(9) COMP VALUE +0.
77 FILL-COUNT PIC S9(9) COMP VALUE +0.
77 NULL-IND PIC S9(4) COMP VALUE +0.
77 PARM-NAME PIC X(20).
77 PARM-NAME-LNG PIC S9(9) COMP.
77 PARM-FILLCHAR PIC X(1) VALUE SPACES.
77 PARM-ID PIC S9(9) COMP.
77 PARM-STATUS PIC S9(9) COMP.
77 PARM-DATA-TYPE PIC S9(9) COMP.
77 PARM-DATA-LNG PIC S9(9) COMP.
77 PARM-LNG PIC S9(9) COMP.
77 PARM-MAXLNG PIC S9(9) COMP.
77 PARM-NUMROW PIC S9(9) COMP VALUE +0.
77 PARM-UDT PIC S9(9) COMP.
77 REQ-TYPE PIC S9(9) COMP VALUE +0.
77 RETURN-STATUS PIC S9(9) COMP VALUE +0.
01 ROW-DATA.
05 ROW-CHAR PIC X(1) VALUE SPACES
OCCURS 80 TIMES.
77 RPC-NAME PIC X(4) VALUE 'TS02'.
77 RPC-NAME-LENGTH PIC S9(9) COMP VALUE +4.
77 SNA-CONNECTION-NAME PIC X(8) VALUE SPACES.
77 SNA-SUBCODE PIC S9(9) COMP.
77 WAIT-OPTION PIC S9(9) COMP VALUE +0.
01 CMD PIC S9(9) COMP SYNC.
01 REMOTE-TRACE-FLAG PIC S9(9) USAGE COMP SYNC.
01 TDS-VERSION PIC S9(9) USAGE COMP.
01 LONGVAR-TRUNC-FLAG PIC S9(9) USAGE COMP.
01 ROW-LIMIT PIC S9(9) USAGE COMP.
01 USER-CORRELATOR PIC S9(9) USAGE COMP.
01 DB2GW-OPTIONS PIC S9(9) USAGE COMP.
01 DB2GW-PID PIC X(1).
77 ERR-MSG PIC X(40) VALUE IS SPACES.
77 ERR-MSG-LEN PIC S9(9) USAGE COMP VALUE IS 40.
01 NO-OF-ROWS PIC S9(9) USAGE COMP VALUE IS 0.
01 ROWS-TOTAL PIC S9(9) USAGE COMP VALUE IS 0.
01 SEND-STATUS PIC S9(9) USAGE COMP SYNC.
01 STATUS-NUMBER PIC S9(9) USAGE COMP SYNC.
01 OPEN-COUNT PIC S9(9) USAGE COMP VALUE IS 0.
01 SAVE-CURSOR-ID PIC S9(9) USAGE COMP SYNC.
01 SQLSTR PIC X(300) VALUE IS SPACES.
01 MAX-SQL-LENGTH PIC S9(9) USAGE COMP VALUE IS 300.
01 ACT-SQL-LENGTH PIC S9(9) USAGE COMP.
01 COL1-DATA PIC X(20) VALUE IS SPACES.
01 COL2-DATA PIC S9(9) USAGE COMP.
01 UPDATES-THIS-CURSOR PIC S9(9) USAGE COMP.
01 DELETES-THIS-CURSOR PIC S9(9) USAGE COMP.
*----------------------------------------------------------------
* Server library COBOL copybook
*----------------------------------------------------------------
COPY SYGWCOB.
*----------------------------------------------------------------
* Procedure division.
*----------------------------------------------------------------
PROCEDURE DIVISION.
* Initialize TDS environment
CALL 'TDINIT' USING DFHEIBLK, GWL-RC, GWL-INIT-HANDLE.
* Accept client request
CALL 'TDACCEPT' USING GWL-PROC, GWL-RC, GWL-INIT-HANDLE,
SNA-CONNECTION-NAME, SNA-SUBCODE.
* If no parameters set 20 rows and wait for cursor command
CALL 'TDRESULT' USING GWL-PROC, GWL-RC.
IF GWL-RC NOT EQUAL TDS-PARM-PRESENT THEN
MOVE 20 TO PARM-NUMROW
CALL 'TDSNDDON' USING GWL-PROC, GWL-RC, TDS-DONE-FINAL,
PARM-NUMROW, TDS-ZERO, TDS-ENDREPLY
GO TO NEXT-STEP.
* Read in user parameters, and process the request
* only parameter for now is number of rows requested
* Get info for RPC parameter 1 - number rows
MOVE 1 TO PARM-ID.
CALL 'TDINFPRM' USING GWL-PROC, GWL-RC, PARM-ID,
PARM-DATA-TYPE, PARM-LNG, PARM-MAXLNG,
PARM-STATUS, PARM-NAME, PARM-NAME-LNG,
PARM-UDT.
* Initialize the cursor-id , 111 is not significant number
MOVE 111 TO SAVE-CURSOR-ID.
* Get number of row to return from RPC parameter 2
* if parmeter is not entered then return 20 rows
IF GWL-RC = 0
CALL 'TDRCVPRM' USING GWL-PROC, GWL-RC, PARM-ID,
PARM-NUMROW, TDSINT4, PARM-MAXLNG, PARM-LNG
ELSE
STRING 'PARM 1 SHOULD BE INT4'
DELIMITED BY SIZE INTO ERR-MSG
PERFORM SEND-ERROR.
* we are assuming client program just starts long running rpc
* used with the cursor support we are adding in 3.1
CALL 'TDSNDDON' USING GWL-PROC, GWL-RC, TDS-DONE-FINAL,
PARM-NUMROW, TDS-ZERO, TDS-ENDREPLY.
* Wait for the next request from the client
PERFORM NEXT-STEP.
GOT-REQ.
CALL 'TDINFPGM' USING GWL-PROC GWL-RC TDS-VERSION
LONGVAR-TRUNC-FLAG ROW-LIMIT
REMOTE-TRACE-FLAG USER-CORRELATOR
DB2GW-OPTIONS DB2GW-PID REQ-TYPE.
* make sure we are getting a cursor command from the client
IF REQ-TYPE NOT EQUAL TDS-CURSOR-EVENT
STRING 'REQ-TYPE NOT EQUAL TDS-CURSOR-EVENT'
DELIMITED BY SIZE INTO ERR-MSG
PERFORM SEND-ERROR.
* look at the incoming request and perform necessary action
* in this simple example we just handle the client cursor requests
MOVE TDS-GET TO CMD.
CALL 'TDCURPRO' USING GWL-PROC, GWL-RC,
CMD, CURSOR-DESC.
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDCURPRO GET FAILED' DELIMITED BY SIZE
INTO ERR-MSG
PERFORM SEND-ERROR.
EVALUATE CURSOR-COMMAND
WHEN TDS-CURSOR-DECLARE
PERFORM DECLARE-LOGIC
WHEN TDS-CURSOR-INFO
PERFORM INFO-LOGIC
WHEN TDS-CURSOR-OPENCMD
PERFORM OPEN-LOGIC
WHEN TDS-CURSOR-FETCH
PERFORM FETCH-LOGIC
WHEN TDS-CURSOR-UPDATE
PERFORM UPDATE-LOGIC
WHEN TDS-CURSOR-DELETE
PERFORM DELETE-LOGIC
WHEN TDS-CURSOR-CLOSE
PERFORM CLOSE-LOGIC
WHEN TDS-CURSOR-DEALLOC
* not a lot of meaning here as in server it frees structures
* we will never require the client to deallocate
* in a very large application this might be necessary
PERFORM DEALLOC-LOGIC
WHEN OTHER
STRING 'TDCURPRO GOT UNEXPECTED CMD REQUEST'
DELIMITED BY SIZE INTO ERR-MSG
PERFORM SEND-ERROR
END-EVALUATE.
PERFORM NEXT-STEP.
NEXT-STEP.
PERFORM DO-GET-REQ.
PERFORM GOT-REQ.
DO-GET-REQ.
CALL 'TDGETREQ' USING GWL-PROC GWL-RC WAIT-OPTION
REQ-TYPE RPC-NAME.
IF REQ-TYPE NOT EQUAL TDS-CURSOR-EVENT
GO TO END-OF-REQUESTS.
DECLARE-LOGIC.
* set CURSOR-ID and CURSOR-STATUS
* increment the cursors we have used
ADD 1 TO SAVE-CURSOR-ID.
MOVE SAVE-CURSOR-ID TO CURSOR-ID.
PERFORM DECLARE-VALIDATION.
PERFORM TDSSET-CURSOR.
PERFORM SEND-ENDREPLY-200.
DECLARE-VALIDATION.
* the cursor must be CRSLONG, initially and then CRSRESULTS
* this is a little harsh but the
* sample is only meant to work with its counter part embedded sql
* or ctlibrary sample program
* the name implies that this is a long running transaction
* it is possible to not be a long running transaction but the
* program would have to be the default language transaction at
* the mainframe server gateway, which is not very likely
* one could do much more in this validation
IF CURSOR-NAME IS EQUAL 'CRSLONG' OR CURSOR-NAME
IS EQUAL 'CRSRESULTS' PERFORM COMPARE-SQL.
COMPARE-SQL.
* could look at the incoming sql w/cursor and have logic if needed
* but we don't care about the sql received at all for the sample
* in a real program one could use this to pass a where clause etc
* for the logic which is to materialize the results
CALL 'TDRCVSQL' USING GWL-PROC GWL-RC
SQLSTR MAX-SQL-LENGTH
ACT-SQL-LENGTH.
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDRCVSQL FAILED'
DELIMITED BY SIZE
INTO ERR-MSG
PERFORM SEND-ERROR.
INFO-LOGIC.
* Here our assumption is that row count is set via client program
PERFORM TDSSET-CURSOR.
PERFORM SEND-ENDREPLY-200.
OPEN-LOGIC.
* for this sample we are going to only return 20 rows
* if no parameter specified. With real data the actual data source
* determines the number of fetches
* initialize counters for the total number of updates and deletes
* which are performed on this cursor. In this sample we will
* communicate this back to the client after the cursor is
* closed. In real applications data would be deleted or updated
* for the results cursor only 2 rows returned
IF CURSOR-NAME IS EQUAL 'CRSLONG'
MOVE PARM-NUMROW TO ROWS-TOTAL
MOVE 0 TO UPDATES-THIS-CURSOR
MOVE 0 TO DELETES-THIS-CURSOR
ELSE
MOVE 2 TO ROWS-TOTAL.
* describe results
* MOVE TDS-CURSOR-OPEN TO CURSOR-STATUS
PERFORM TDSSET-CURSOR.
* for this problem just send two columns of data
PERFORM SEND-TWO-COLUMN.
PERFORM SEND-OPEN.
FETCH-LOGIC.
PERFORM TDSSET-CURSOR.
* send fetch-count number of rows to the client
* fetch-count set in cursor descriptor block
* the following code assumes that the fetch-count is
* an integral multiple of actual data
* when the row count is zero then there is one more fetch
* which just gets the SQLCODE 100
IF ROWS-TOTAL NOT EQUAL ZERO
IF ROWS-TOTAL LESS THAN FETCH-COUNT
MOVE ROWS-TOTAL TO NO-OF-ROWS
ELSE
MOVE FETCH-COUNT TO NO-OF-ROWS END-IF
PERFORM SEND-ROW
UNTIL NO-OF-ROWS = 0 OR ROWS-TOTAL = 0
ELSE PERFORM SEND-ENDREPLY-200 END-IF.
SEND-ROW.
* if we are using results cursor then send different data
IF CURSOR-NAME IS EQUAL 'CRSRESULTS'
IF ROWS-TOTAL = 2
MOVE 'Updates last cursor ' TO COL1-DATA
MOVE UPDATES-THIS-CURSOR TO COL2-DATA
ELSE
MOVE 'Deletes last cursor ' TO COL1-DATA
MOVE DELETES-THIS-CURSOR TO COL2-DATA END-IF
END-IF
* send a row of data
CALL 'TDSNDROW' USING GWL-PROC, GWL-RC
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDSNDROW FAILED'
DELIMITED BY SIZE
INTO ERR-MSG
PERFORM SEND-ERROR.
SUBTRACT 1 FROM NO-OF-ROWS.
SUBTRACT 1 FROM ROWS-TOTAL.
IF NO-OF-ROWS = 0 OR ROWS-TOTAL = 0
PERFORM SEND-ENDREPLY-200.
UPDATE-LOGIC.
PERFORM TDSSET-CURSOR.
PERFORM COMPARE-SQL.
* at this point we would look at the update sql to decide
* what must be done, in our case just move information to
* the column data being returned
* looking at the text string is more than we want to do here so
* move a couple some new data to the colums being
* returned to show that the update was processed and add one
* to the update counter
*
* this doesn't appear to the client to be very accurate unless
* the fetch-count is 1 as the fetch here is out of sync with
* the one the application is issuing
IF FETCH-COUNT = 1
MOVE 'Updated col1 data ' TO COL1-DATA
MOVE 123 TO COL2-DATA END-IF
ADD 1 TO UPDATES-THIS-CURSOR.
PERFORM SEND-ENDREPLY-200.
DELETE-LOGIC.
* on a delete request we have nothing to actually delete so
* we will just update a counter to show the activity took place
PERFORM TDSSET-CURSOR.
ADD 1 TO DELETES-THIS-CURSOR.
PERFORM SEND-ENDREPLY-200.
CLOSE-LOGIC.
PERFORM TDSSET-CURSOR.
PERFORM SEND-ENDREPLY-200.
DEALLOC-LOGIC.
STRING 'DEALLOC NOT IMPLEMENTED'
DELIMITED BY SIZE
INTO ERR-MSG
PERFORM SEND-ERROR.
PERFORM SEND-ENDREPLY-200.
SEND-OPEN.
PERFORM SEND-ENDREPLY-200.
TDSSET-CURSOR.
MOVE TDS-SET TO CMD.
CALL 'TDCURPRO' USING GWL-PROC, GWL-RC,
CMD, CURSOR-DESC.
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDCURPRO SET FAILED' DELIMITED BY SIZE
INTO ERR-MSG
PERFORM SEND-ERROR.
SEND-ENDREPLY-200.
MOVE TDS-DONE-FINAL TO SEND-STATUS.
ADD TDS-DONE-COUNT TO SEND-STATUS.
MOVE 200 TO STATUS-NUMBER.
CALL 'TDSNDDON' USING GWL-PROC GWL-RC
SEND-STATUS
NO-OF-ROWS STATUS-NUMBER TDS-ENDREPLY.
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDSNDDON FAILED'
DELIMITED BY SIZE INTO ERR-MSG
PERFORM SEND-ERROR.
SEND-TWO-COLUMN.
MOVE 1 TO OPEN-COUNT.
MOVE 1 TO COL-COUNT.
MOVE 'COL1' TO COLUMN-NAME.
* Describe the column host variable to the client
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC, COL-COUNT, TDSCHAR,
COL-20, COL1-DATA, NULL-IND, TDS-FALSE,
TDSCHAR, COL-20, COLUMN-NAME,
COLUMN-NAME-LEN.
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDESCRIB FAILED'
DELIMITED BY SIZE INTO ERR-MSG
PERFORM SEND-ERROR.
ADD 1 TO COL-COUNT.
MOVE 'COL2' to COLUMN-NAME.
MOVE LENGTH OF COL2-DATA TO COL2-LNG.
* Describe the column host variable to the client
CALL 'TDESCRIB' USING GWL-PROC, GWL-RC, COL-COUNT, TDSINT4,
COL2-LNG, COL2-DATA, NULL-IND,
TDS-FALSE,
TDSINT4, COL2-LNG, COLUMN-NAME,
COLUMN-NAME-LEN.
IF GWL-RC NOT EQUAL TDS-OK
STRING 'TDESCRIB FAILED'
DELIMITED BY SIZE INTO ERR-MSG
PERFORM SEND-ERROR.
* Here we are just hardcoding some meaningless data into
* these columns. In a real application there must be some
* logic here to update the data columns.
MOVE 'ABCDEFGHIJabcdefghij' TO COL1-DATA.
MOVE 999 TO COL2-DATA.
* Transaction termination routine
END-OF-REQUESTS.
* Send result completion to the client
CALL 'TDSNDDON' USING GWL-PROC, GWL-RC, TDS-DONE-FINAL,
TDS-ZERO, RETURN-STATUS, TDS-ENDRPC.
* Free the session data structure and exit
CALL 'TDFREE' USING GWL-PROC, GWL-RC.
EXEC CICS RETURN END-EXEC.
SEND-ERROR.
CALL 'TDSNDMSG' USING GWL-PROC GWL-RC
TDS-ERROR-MSG TDS-SYBERDNR TDS-EXUSER
TDS-ZERO TDS-ZERO
RPC-NAME RPC-NAME-LENGTH
ERR-MSG ERR-MSG-LEN.
PERFORM END-OF-REQUESTS.
