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.