Sample COBOL programs
This appendix contains the complete source code for the sample Common Business Oriented Language (COBOL) programs referred to in this book. The source code is also available to download separately. For more information about how to obtain these additional materials, see Appendix C, “Additional material” on page 175.
Sample programs for CICS as a client for JSON web services
The Customer Information Control System (CICS) programs in this section are referred to in Chapter 11, “Developing a simple JSON web service client application” on page 127. They consist of a sample client application that calls a JavaScript Object Notation (JSON) web service, and a service provider application to test the client.
Sample client application
This section contains a sample COBOL program (Example B-1) that demonstrates using the linkable interface to transform JSON and WEB application programming interface (API) commands to call a JSON web service. It calls a sample provider application, which is supplied in “Sample provider application” on page 173.
For more information about how the program works, see 11.5, “Developing the application program” on page 142. For information about how to test the program, see 11.6, “Testing the sample application” on page 148.
Example B-1 Sample client application
CBL CICS('COBOL3') APOST
*****************************************************************
* *
* MODULE NAME = REQUeST *
* *
* DESCRIPTIVE NAME = Sample program demonstrating CICS *
* as a client for a JSON web service *
* @BANNER_START@ 02 *
* *
* Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* *
* (C) Copyright IBM Corp. 2013 *
* *
* *
* *
* *
* @BANNER_END@ *
* *
* *
* *
* TRANSACTION NAME = n/a *
* *
* *
*------------------------------------------------------------- *
* *
* ENTRY POINT = REQUEST *
* *
*------------------------------------------------------------- *
* *
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. REQUEST.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*----------------------------------------------------------------*
* Common defintions *
*----------------------------------------------------------------*
01 COMPLETED-MSG.
03 INITIAL-TEXT PIC X(20) VALUE 'INSURANCE SCORE WAS '.
03 SCORE-TEXT PIC X(3).
* Data structures to hold the input and output data
01 REQUEST-DATA.
COPY SCREQ01.
01 RESPONSE-DATA.
COPY SCRESP01.
01 WORKING-VARIABLES.
03 TRANS-RESP PIC S9(8) COMP.
03 CICS-RESP PIC S9(8) COMP.
03 CICS-RESP2 PIC S9(8) COMP.
03 HTTP-RESP PIC S9(4) COMP.
03 TOKEN PIC S9(16) COMP.
03 ERROR-LENGTH PIC S9(8) COMP.
03 BAD-TRANS-RESP.
05 MSG-TEXT PIC X(48) VALUE
'An error occurred when transforming JSON, code: '.
05 ERROR-DISPLAY PIC X(8).
03 BAD-CICS-RESP PIC X(47) VALUE
'An unexpected error occurred in a CICS command.'.
03 BAD-WEB-RESP PIC X(52) VALUE
'An error occurred connected to the JSON web service.'.
03 BAD-URIMAP PIC X(26) VALUE 'URIMAP could not be found.'.
03 HTTP-MSG.
05 MSG-TEXT PIC X(19) VALUE 'BAD HTTP RESPONSE: '.
05 HTTP-RESP-DISPLAY PIC XXXX.
05 GAP PIC X VALUE IS SPACES.
05 HTTPSTATUS PIC X(50).
03 CONTENT-TYPE PIC X(56) VALUE 'application/json'.
03 ERROR-MSG PIC X(256).
*-----------------------------------------------------------
******************************************************************
* L I N K A G E S E C T I O N
******************************************************************
LINKAGE SECTION.
******************************************************************
* P R O C E D U R E S
******************************************************************
PROCEDURE DIVISION.
*----------------------------------------------------------------*
MAINLINE SECTION.
*----------------------------------------------------------------*
* Common code *
*----------------------------------------------------------------*
INITIALIZE TRANS-RESP
INITIALIZE CICS-RESP
MOVE 'JOE' TO FIRSTNAME
MOVE 'BLOGGS' TO LASTNAME
MOVE 67 TO HOUSENUMBER
MOVE '10/10/1984' TO DOB
MOVE 'N00 BDY' TO POSTCODE
MOVE 3 TO POLICYTYPE
EXEC CICS PUT CONTAINER('DFHJSON-TRANSFRM')
CHANNEL('CHAN')
FROM('SCOREREQ')
CHAR
RESP(CICS-RESP)
END-EXEC
PERFORM CHECK-RESP
EXEC CICS PUT CONTAINER('DFHJSON-DATA')
CHANNEL('CHAN')
FROM(REQUEST-DATA)
RESP(CICS-RESP)
END-EXEC
PERFORM CHECK-RESP
* Link to the transfomer
EXEC CICS LINK PROGRAM('DFHJSON')
CHANNEL('CHAN')
RESP(CICS-RESP)
END-EXEC
PERFORM CHECK-RESP
PERFORM HANDLE-ERROR
EXEC CICS WEB OPEN
URIMAP('CREDSERV')
SESSTOKEN(TOKEN)
RESP(CICS-RESP)
RESP2(CICS-RESP2)
END-EXEC
PERFORM CHECK-RESP-WEB
EXEC CICS WEB CONVERSE
URIMAP('CREDSERV') POST
CONTAINER('DFHJSON-JSON')
CHANNEL('CHAN')
MEDIATYPE(CONTENT-TYPE)
TOCONTAINER('DFHJSON-JSON')
TOCHANNEL('CHAN')
STATUSCODE(HTTP-RESP)
STATUSTEXT(HTTPSTATUS)
SESSTOKEN(TOKEN)
RESP(CICS-RESP)
RESP2(CICS-RESP2)
END-EXEC
PERFORM CHECK-RESP-WEB
IF HTTP-RESP NOT EQUAL 200
MOVE HTTP-RESP TO HTTP-RESP-DISPLAY
EXEC CICS SEND TEXT FROM(HTTP-MSG)
ERASE END-EXEC
EXEC CICS RETURN END-EXEC
END-IF
EXEC CICS WEB CLOSE SESSTOKEN(TOKEN) END-EXEC
EXEC CICS DELETE CONTAINER('DFHJSON-DATA')
CHANNEL('CHAN')
END-EXEC
EXEC CICS PUT CONTAINER('DFHJSON-TRANSFRM')
CHANNEL('CHAN')
FROM('SCORERESP')
RESP(CICS-RESP)
CHAR
END-EXEC
PERFORM CHECK-RESP
* Link to the transfomer
EXEC CICS LINK PROGRAM('DFHJSON')
CHANNEL('CHAN')
RESP(CICS-RESP)
END-EXEC
PERFORM CHECK-RESP
PERFORM HANDLE-ERROR
EXEC CICS GET CONTAINER('DFHJSON-DATA') CHANNEL('CHAN')
INTO(RESPONSE-DATA)
RESP(CICS-RESP)
END-EXEC.
PERFORM CHECK-RESP
MOVE SCORE TO SCORE-TEXT
EXEC CICS SEND TEXT FROM(COMPLETED-MSG) JUSLAST
END-EXEC
EXEC CICS SEND PAGE END-EXEC
EXEC CICS RETURN END-EXEC.
EXIT.
HANDLE-ERROR.
EXEC CICS GET CONTAINER('DFHJSON-ERROR') CHANNEL('CHAN')
INTO(TRANS-RESP)
RESP(CICS-RESP)
END-EXEC
IF CICS-RESP EQUAL DFHRESP(NORMAL)
* Error container is present, output value
MOVE TRANS-RESP TO ERROR-DISPLAY
EXEC CICS SEND TEXT FROM(BAD-TRANS-RESP)
ERASE END-EXEC
MOVE 256 TO ERROR-LENGTH
EXEC CICS GET CONTAINER('DFHJSON-ERRORMSG')
CHANNEL('CHAN')
INTO(ERROR-MSG)
RESP(CICS-RESP)
FLENGTH(ERROR-LENGTH)
END-EXEC
IF CICS-RESP EQUAL DFHRESP(NORMAL)
DISPLAY ERROR-MSG
END-IF
EXEC CICS RETURN END-EXEC
END-IF
EXIT.
CHECK-RESP.
IF CICS-RESP NOT EQUAL DFHRESP(NORMAL)
EXEC CICS SEND TEXT FROM(BAD-CICS-RESP)
ERASE
END-EXEC
EXEC CICS RETURN END-EXEC
END-IF
EXIT.
CHECK-RESP-WEB.
IF CICS-RESP NOT EQUAL DFHRESP(NORMAL)
IF CICS-RESP EQUAL DFHRESP(NOTFND)
AND CICS-RESP2 EQUAL 1
EXEC CICS SEND TEXT FROM(BAD-URIMAP)
ERASE
END-EXEC
ELSE
EXEC CICS SEND TEXT FROM(BAD-WEB-RESP)
ERASE
END-EXEC
END-IF
EXEC CICS RETURN END-EXEC
END-IF
EXIT.
Sample provider application
This section contains a program (Example B-2) that can be used as a JSON web service provider to test the sample client application.
Example B-2 Sample provider application
CBL CICS('COBOL3') APOST
*****************************************************************
* *
* MODULE NAME = CREDIT *
* *
* DESCRIPTIVE NAME = Service provider application for *
* insurance credit score service *
* @BANNER_START@ 02 *
* CREDIT *
* Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* *
* (C) Copyright IBM Corp. 2013 *
* *
* *
* *
* *
* @BANNER_END@ *
* *
* *
* TRANSACTION NAME = n/a *
* *
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CREDIT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*----------------------------------------------------------------*
* Common defintions *
*----------------------------------------------------------------*
01 CUSTID-SEED PIC 9(9).
01 SCORE-SEED PIC 9(9).
* Data structures to hold the input and output data
* Due to copy books containing 'SYNC' members must be held
* individually with an 01 level structure to ensure they are
* aligned on a double word boundry
01 REQUEST-CONTAINER-DATA.
COPY CRREQ01.
01 RESPONSE-CONTAINER-DATA.
COPY CRRESP01.
*-----------------------------------------------------------
******************************************************************
* L I N K A G E S E C T I O N
******************************************************************
LINKAGE SECTION.
******************************************************************
* P R O C E D U R E S
******************************************************************
PROCEDURE DIVISION.
*----------------------------------------------------------------*
MAINLINE SECTION.
*---------------------------------------------------------------*
* Get the input data from the supplied container *
*---------------------------------------------------------------*
EXEC CICS GET CONTAINER('DFHWS-DATA')
INTO(REQUEST-CONTAINER-DATA)
END-EXEC
COMPUTE SCORE-SEED = POLICYTYPE + CUSTID-SEED
COMPUTE SCORE = FUNCTION RANDOM(SCORE-SEED) * 900 + 100
COMPUTE CUSTID-SEED = FUNCTION NUMVAL(HOUSENUMBER)
COMPUTE CUSTOMERID = FUNCTION RANDOM(CUSTID-SEED) * 90000000
ADD 10000000 TO CUSTOMERID
EXEC CICS ASKTIME ABSTIME(TIMESTAMP) END-EXEC
EXEC CICS PUT CONTAINER('DFHWS-DATA')
FROM(RESPONSE-CONTAINER-DATA)
END-EXEC
* Return to caller
EXEC CICS RETURN END-EXEC.
MAINLINE-EXIT.
EXIT.
*----------------------------------------------------------------*
..................Content has been hidden....................
You can't read the all page of ebook, please click here login for view all page.