CLI2CTB Program Listing
IDENTIFICATION DIVISION. PROGRAM-ID. CLI2CTB
AUTHOR. J LAHOOD.
INSTALLATION. TDAT.
REMARKS. THIS PROGRAM PROVIDES AN EXAMPLE OF HOW A CLI2
* PROGRAM CAN CALL ANOTHER PROGRAM TO PERFORM SUB FUNCTIONS.
* THIS PROGRAM IS CALLED BY THE FOLLOWING SAMPLE PROGRAMS:
*
*
* CLI2MCB (MULTI-SESSION/COBOL/BATCH)
* CLI2MCI (MULTI-SESSION/COBOL/IMS)
* CLI2MPB (MULTI-SESSION/PLI/BATCH)
* CLI2MPI (MULTI-SESSION/PLI/IMS)
*
* -- TO DROP THEN CREATE THE TABLE “MYTABLE2".
*
* THE “DBCAREA” USED BY THE THIS PROGRAM IS LOCATED
* IN THE WORKING STORAGE(COBOL) OR STATIC STORAGE (PL/I)
* OF THE CALLING PROGRAM. THIS PROGRAM DEFINES THE
* DBCAREA IN ITS LINKAGE SECTION.
*
*
* THE CONNECT FUNCTION IS PERFORMED BY THE CALLING PROGRAM.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
************************************************************
* DATA DEFINITIONS *
* *
************************************************************
* CONSTANTS.
* CURRENT NUMBER OF SESSIONS.
77 NUMBER-OF-SESSIONS PIC 9999 VALUE IS 0 COMP.
* MAXIMUM RESPONSE BUFFER SIZE FOR FETCHING
* (MUST BE SPECIFIED WHEN IN MOVE MODE).
77 RESPBUF-SIZE PIC S9(9) COMP VALUE IS +4096.
* DBC/SQL REQUEST TO BE EXECUTED.
77 REQUEST-BUF PIC X(60) VALUE IS SPACES.
* LENGTH OF DBC/SQL REQUEST.
77 REQ-LEN PIC 9(9) VALUE IS 60 COMP.
* LENGTH OF VARIABLE LENGTH MESSAGES (OCCURS BY)
77 TEXT-LEN PIC 9999 COMP VALUE IS 0.
* CLI RETURN CODES
77 EOF-CODE PIC S9(9) VALUE +33 COMP.
77 CRASH-CODE PIC S9(9) VALUE +286 COMP.
* LAST REQUEST IRQ’D
77 LAST-REQUEST PIC X(6) VALUE IS SPACES.
********************************************************************
01 DBC-SQL-REQUESTS.
05 FILLER PIC X(6) VALUE ’DROP’.
05 FILLER PIC X(60) VALUE
’DROP TABLE MYTABLE2;’.
05 FILLER PIC X(6) VALUE ’CT’.
05 FILLER PIC X(60) VALUE
’CT MYTABLE2,NO FALLBACK (F1 INTEGER,F2 INTEGER);’.
05 FILLER PIC X(6) VALUE ’ENDREQ’.
05 FILLER PIC X(60) VALUE ’DUMMY’.
01 DBC-SQL-TEST-DRIVER REDEFINES DBC-SQL-REQUESTS.
05 DBC-SQL-REQUEST OCCURS 3 TIMES INDEXED BY REQUEST-INDEX.
10 REQUEST-TYPE PIC X(6).
10 REQUEST PIC X(60).
********************************************************************
* CLI REQUIRED PARAMETERS
01 CLI-RETURN-CODE PIC S9(9) VALUE +0 COMP.
01 CONTEXT-PTR PIC S9(9) VALUE +0 COMP.
* DBC FUNCTION CODES
01 FUNCTIONS.
05 CONNECT-FUNC PIC S9(9) VALUE +1 COMP.
05 DISCONNECT-FUNC PIC S9(9) VALUE +2 COMP.
05 RUN-STARTUP-FUNC PIC S9(9) VALUE +3 COMP.
05 INITIATE-REQ-FUNC PIC S9(9) VALUE +4 COMP.
05 FETCH-FUNC PIC S9(9) VALUE +5 COMP.
05 REWIND-FUNC PIC S9(9) VALUE +6 COMP.
05 ABORT-FUNC PIC S9(9) VALUE +7 COMP.
05 END-REQUEST-FUNC PIC S9(9) VALUE +8 COMP.
* COMMON PARCEL FLAVORS
01 FLAVOR.
05 SUCCESS-TYPE PIC S9(9) VALUE +8 COMP.
05 FAILURE-TYPE PIC S9(9) VALUE +9 COMP.
05 RECORD-TYPE PIC S9(9) VALUE +10 COMP.
05 END-STATEMENT-TYPE PIC S9(9) VALUE +11 COMP.
05 END-REQUEST-TYPE PIC S9(9) VALUE +12 COMP.
05 ERROR-TYPE PIC S9(9) VALUE +49 COMP.
05 DATA-INFO-TYPE PIC S9(9) VALUE +71 COMP.
* PARCEL WORK AREA FOR MOVE MODE PARCEL FETCHES
01 PARCEL PIC X(4096) VALUE LOW-VALUES.
* FAILURE OR ERROR PARCEL
01 FAIL-ERROR-PCL REDEFINES PARCEL.
05 STATEMENT-NO PIC S9(4) COMP.
05 INFO PIC S9(4) COMP.
05 ERROR-CODE PIC S9(4) COMP.
05 ERROR-LEN PIC S9(4) COMP.
05 ERROR-MSG PIC X(256).
01 VARMSG.
10 VTEXT OCCURS 1 TO 256 TIMES DEPENDING ON TEXT-LEN.
15 TEXT-DUM PIC X.
LINKAGE SECTION.
01 DBCAREA.
COPY DBCALS.
01 MSG-INFO.
02 MSG-INFO-FUNC PIC S9(9) COMP.
02 MSG-INFO-RC PIC S9(9) COMP.
02 MSG-INFO-CLI-MSG PIC X(76).
02 MSG-INFO-FECODE PIC S9(9) COMP.
02 MSG-INFO-LEN PIC S9(4) COMP.
02 MSG-INFO-TEXT PIC X(256).
PROCEDURE DIVISION USING DBCAREA, MSG-INFO.
BEGIN.
PERFORM DBCAREA-SETUP.
PERFORM CLI-CONNECT.
SET REQUEST-INDEX TO 1.
MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF.
PERFORM FETCH-THEN-IRQ UNTIL NUMBER-OF-SESSIONS = ZERO.
GOBACK.
************************************************************
* PERFORMED PARAGRAPHS. *
************************************************************
********* FETCH PARCELS FOR PREVIOUS IRQ OR CONNECT ****
********* IF EOF, INITIATE INSERT REQUEST **********
FETCH-THEN-IRQ.
PERFORM CLI-FETCH-PARCELS UNTIL CLI-RETURN-CODE = EOF-CODE
OR CLI-RETURN-CODE = CRASH-CODE.
IF CLI-RETURN-CODE = EOF-CODE THEN
PERFORM CLI-END-REQUEST
IF REQUEST-TYPE(REQUEST-INDEX) = ’ENDREQ’
PERFORM CLI-DISCONNECT
ELSE
PERFORM CLI-IRQ
PERFORM ADVANCE-TO-NEXT-REQUEST
ELSE PERFORM DISP-ERROR.
************************************************************
***************** ADVANCE TO NEXT REQUEST **********
ADVANCE-TO-NEXT-REQUEST.
SET REQUEST-INDEX UP BY 1
MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF.
************************************************************
***************** FETCH PARCELS **********
CLI-FETCH-PARCELS.
MOVE FETCH-FUNC TO DBCAREA-FUNC.
CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA.
IF CLI-RETURN-CODE NOT = EOF-CODE
PERFORM DISPLAY-PARCEL.
************************************************************
***************** INITIATE INSERT REQUEST **********
CLI-IRQ.
MOVE REQUEST-TYPE(REQUEST-INDEX) TO LAST-REQUEST.
MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC.
CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA.
IF CLI-RETURN-CODE = ZERO
MOVE DBCAREA-O-REQ-ID TO DBCAREA-I-REQ-ID
ELSE PERFORM DISP-ERROR.
************************************************************
***************** TERMINATE REQUEST **********
CLI-END-REQUEST.
MOVE END-REQUEST-FUNC TO DBCAREA-FUNC.
CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA.
IF CLI-RETURN-CODE NOT = 0
PERFORM DISP-ERROR.
************************************************************
***************** DISCONNECT SESSION **********
CLI-DISCONNECT.
MOVE DISCONNECT-FUNC TO DBCAREA-FUNC.
CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA.
IF CLI-RETURN-CODE NOT = 0
PERFORM DISP-ERROR.
SUBTRACT 1 FROM NUMBER-OF-SESSIONS.
************************************************************
***************** DISPLAY PARCEL **********
DISPLAY-PARCEL.
IF (DBCAREA-FET-PARCEL-FLAVOR = ERROR-TYPE OR
DBCAREA-FET-PARCEL-FLAVOR = FAILURE-TYPE)
AND LAST-REQUEST NOT = ’DROP’
MOVE ERROR-LEN TO MSG-INFO-LEN
MOVE ERROR-MSG TO MSG-INFO-TEXT
GOBACK.
************************************************************
***************** DISPLAY ERROR MESSAGE **********
DISP-ERROR.
MOVE CLI-RETURN-CODE TO MSG-INFO-RC.
IF DBCAREA-MSG-LEN GREATER ZERO
MOVE DBCAREA-MSG-TEXT TO MSG-INFO-CLI-MSG.
GOBACK.
************************************************************
***************** CONNECT SESSION **********
CLI-CONNECT.
MOVE CONNECT-FUNC TO DBCAREA-FUNC.
CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA.
IF CLI-RETURN-CODE NOT = 0
PERFORM DISP-ERROR.
MOVE DBCAREA-O-SESS-ID TO DBCAREA-I-SESS-ID.
MOVE DBCAREA-O-REQ-ID TO DBCAREA-I-REQ-ID.
ADD +1 TO NUMBER-OF-SESSIONS.
************************************************************
DBCAREA-SETUP.
************************************************************
* SET UP DBCHSAD CALLS (STORE ADDRESSES IN DBCAREA) *
* AND OTHER DBCAREA CONSTANTS. *
************************************************************
****** SET UP POINTER TO TERADATA SQL STATEMENT.
CALL ’DBCHSAD’ USING CLI-RETURN-CODE,
DBCAREA-SQL-PTR, REQUEST-BUF.
****** SET UP LENGTH OF TERADATA SQL STATEMENT.
MOVE REQ-LEN TO DBCAREA-SQL-LEN.
****** SET UP POINTER TO PARCEL AREA (MOVE MODE)
CALL ’DBCHSAD’ USING CLI-RETURN-CODE,
DBCAREA-FET-DATA-PTR, PARCEL.
******* SET UP MAX SIZE FOR PARCEL (REQUIRED FOR MOVE MODE)
MOVE RESPBUF-SIZE TO DBCAREA-FET-I-MAX-DATA-LEN.
************************************************************
* SET MOVE-MODE OPTION FOR COBOL PROGRAMS, *
* I.E. “NO” LOCATE MODE . *
************************************************************
MOVE ’N’ TO DBCAREA-LOC-MODE.
************************************************************
* SET ’Y’ FOR WAIT-ACROSS-CRASH OPTION. *
* (TECHNIQUE USED BY THIS SAMPLE PROGRAM) *
************************************************************
MOVE ’Y’ TO DBCAREA-WAIT-ACROSS-CRASH.
************************************************************
* SET ’N’ FOR TELL-ABOUT-CRASH OPTION. *
* (TECHNIQUE USED BY THIS SAMPLE PROGRAM) *
************************************************************
MOVE ’N’ TO DBCAREA-TELL-ABOUT-CRASH.
************************************************************
* SET ’Y’ TO TRIGGER CHANGED OPTIONS. *
* *
************************************************************
MOVE ’Y’ TO DBCAREA-CHANGE-OPTS.
MOVE ZERO TO MSG-INFO-RC.
MOVE ZERO TO MSG-INFO-LEN.
MOVE SPACES TO MSG-INFO-CLI-MSG.
MOVE SPACES TO MSG-INFO-TEXT.
* END OF SOURCE CODE.