IDENTIFICATION DIVISION. PROGRAM-ID. CLI2SCI. AUTHOR. J LAHOOD. INSTALLATION. TDAT. REMARKS. THIS PROGRAM PROVIDES AN EXAMPLE OF HOW THE CLI2 * INTERFACE CAN BE USED TO PERFORM THE FOLLOWING FUNCTIONS: * -- DROP THEN CREATE A TABLE. * -- INSERT ROWS INTO THE TABLE (values from “using data”). * -- UPDATE ALL ROWS (Single Transaction). * -- SELECT ROWS FROM THE TABLE (WHERE FIELD = “using data”) * -- DISPLAY FETCHED PARCELS. * -- TERMINATE A REQUEST AFTER RESPONSE PARCELS HAVE BEEN * FETCHED. * -- DISCONNECT A SESSION AFTER ALL REQUESTS HAVE BEEN * PROCESSSED. ***** OPTIONS: * MOVE MODE FETCH (REQUIRED FOR COBOL PROGRAMS) * WAIT FOR RESPONSE * WAIT FOR CRASH RECOVERY = YES * TELL ABOUT CRASH = NO * ***** SINGLE SESSION. * ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-370. OBJECT-COMPUTER. IBM-370. INPUT-OUTPUT SECTION. DATA DIVISION. WORKING-STORAGE SECTION. ********************************************************* * DATA DEFINITIONS * ********************************************************** * CONSTANTS. 77 GET-UNIQUE PIC XXXX VALUE ’GU ’. 77 IN-SERT PIC XXXX VALUE ’ISRT’. 77 NO-MSG PIC XX VALUE ’QX’. * CURRENT NUMBER OF SESSIONS. 77 NUMBER-OF-SESSIONS PIC 9999 VALUE IS 0 COMP. * NUMBER OF ROWS TO BE INSERTED. 77 MAXROWS PIC S9(9) COMP VALUE IS +100. * MAXIMUM RESPONSE BUFFER SIZE FOR FETCHING1fa * (MUST BE SPECIFIED WHEN IN MOVE MODE). 77 RESPBUF-SIZE PIC S9(9) COMP VALUE IS +4096. * LOGON STRING *77 LOGON-STRING PIC X(50) * VALUE ’0/J,LAHOOD ’. * LENGTH OF LOGON STRING 77 LOGON-LEN PIC 9(9) VALUE IS 50 COMP. * DBC/SQL REQUEST TO BE EXECUTED. 77 REQUEST-BUF PIC X(60) VALUE IS SPACES. * LENGTH OF DBC/SQL REQUEST. 77 INSERT-LEN PIC 9(9) VALUE IS 60 COMP. * LENGTH OF VARIABLE LENGTH MESSAGES (OCCURS BY) 77 TEXT-LEN PIC 9999 COMP VALUE IS 0. 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 TERM-OUTPUT. 02 CHAR-COUNT PICTURE S99 COMPUTATIONAL VALUE +79. 02 FILLER PICTURE S99 COMPUTATIONAL VALUE ZERO. * THE FOLLOWING VALUE IS ACTUALLY X’15’ -- NOT BLANK. 02 CAR-RET PICTURE X VALUE ’ ’. 02 OUTPUT-TEXT PICTURE X(132) VALUE SPACES. 01 TERM-INPUT. 02 INPUT-COUNT PICTURE S99 COMPUTATIONAL. 02 FILLER PICTURE S99 COMPUTATIONAL. 02 INPUT-TEXT. 05 LOGON-STRING PIC X(50) VALUE SPACES. 05 FILLER PIC X(120). 01 STATUS-CODE-MSG. 02 FILLER PICTURE X(23) VALUE ’UNEXPECTED STATUS CODE ’. 02 FILL-STATUS PICTURE XX. 02 FILLER PICTURE X(4) VALUE ’ ON ’. 02 FILL-FUNCTION PICTURE X(4). 02 CR-SC PICTURE X. 01 DONE-MSG1. 02 FILLER PICTURE X(40) VALUE ’* TEST SIMP2 COMPLETED WITHOUT ERROR. ’. 02 CR-1 PICTURE X. 01 DONE-MSG2. 02 FILLER PICTURE X(40) VALUE ’ VALIDATE RESULTS USING BTEQ/ITEQ. ’. 02 CR-2 PICTURE X. ************************************************************************* 01 DBC-SQL-REQUESTS. 05 FILLER PIC X(6) VALUE ’DROP’. 05 FILLER PIC X(60) VALUE ’DROP TABLE T;’. 05 FILLER PIC X(6) VALUE ’CT’. 05 FILLER PIC X(60) VALUE ’CREATE TABLE T (I INTEGER,I2 SMALLINT);’. 05 FILLER PIC X(6) VALUE ’INSERT’. 05 FILLER PIC X(60) VALUE ’USING V (INTEGER),V2 (SMALLINT) INS INTO T (:V,:V2);’. 05 FILLER PIC X(6) VALUE ’UPDATE’. 05 FILLER PIC X(60) VALUE ’UPDATE T SET I2 = I + 1 ALL ;’. 05 FILLER PIC X(6) VALUE ’SELECT’. 05 FILLER PIC X(60) VALUE ’ SEL SUM(I) FROM T;’. 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 6 TIMES INDEXED BY REQUEST-INDEX. 10 REQUEST-TYPE PIC X(6). 10 REQUEST PIC X(60). ***************************************************************** 01 DBCAREA. COPY DBCAREAC. * CLI REQUIRED PARAMETERS 01 CLI-RETURN-CODE PIC S9(9) VALUE +0 COMP. 01 CLI-RETURN-DISPLAY PIC ZZZZZZZZ9 . 01 FUNC-DISPLAY PIC ZZZZZZZZ9 . 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. * SUCCESS PARCEL (RELEASE 3.0 AND LATER) 01 SUCCESS-PCL REDEFINES PARCEL. 05 STATEMENT-NO PIC S9(4) COMP. 05 ACTIVITY-COUNT PIC S9(9) COMP. 05 WARNING-CODE PIC S9(4) COMP. 05 FIELD-COUNT PIC S9(4) COMP. 05 ACTIVITY-TYPE PIC S9(4) COMP. 05 WARNING-LEN PIC S9(4) COMP. 05 WARNING-MSG PIC X(256). * FAILURE PARCEL 01 FAILURE-PCL REDEFINES PARCEL. 05 STATEMENT-NO PIC S9(4) COMP. 05 INFO PIC S9(4) COMP. 05 FAILURE-CODE PIC S9(4) COMP. 05 FAILURE-LEN PIC S9(4) COMP. 05 FAILURE-MSG PIC X(256). * ERROR PARCEL 01 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 DATA-RECORD REDEFINES PARCEL. 05 DATA-VALUE PIC S9(9) COMP. 05 DATA-VALUE2 PIC S9(4) COMP. 01 DATA-FIELD-DISPLAY PIC S9(9) SIGN IS LEADING SEPARATE. 01 VARMSG. 10 VTEXT OCCURS 0 TO 256 TIMES DEPENDING ON TEXT-LEN. 15 TEXT-DUM PIC X. 01 DATA-TO-BE-INS-OR-SEL. 05 FIELD1 PIC S9(9) VALUE IS +0 COMP. 05 FIELD2 PIC S9(4) VALUE IS +0 COMP. 01 DATA-LEN-INSERT PIC 9(9) VALUE IS 6 COMP. 01 DATA-LEN-SELECT PIC 9(9) VALUE IS 4 COMP. LINKAGE SECTION. 01 IOPCB. 02 LTERM-NAME PICTURE X(8). 02 FILLER PICTURE XX. 02 IOPCB-STATUS PICTURE XX. 02 IOPCB-PREFIX. 03 FILLER PICTURE X. 03 JULIAN-DATE PICTURE S9(5) COMPUTATIONAL-3. 03 TIME-O-DAY PICTURE S9(7) COMPUTATIONAL-3. 03 FILLER PICTURE XXXX. 01 DBDUMMY PIC X(69). PROCEDURE DIVISION. ENTRY ’DLITCBL’ USING IOPCB, DBDUMMY. BEGIN. PERFORM IMS-GU. STRING ’INPUT AREA = ’, LOGON-STRING DELIMITED BY SIZE INTO OUTPUT-TEXT. PERFORM TERM-OUT. *** BLANK OUT TRANSACTION CODE IN INPUT MESSAGE. EXAMINE INPUT-TEXT REPLACING UNTIL FIRST ’ ’ BY ’ ’. PERFORM DBC-INIT. PERFORM DBCAREA-SETUP. PERFORM CLI-CONNECT. *** SET UP INITIAL DATA FOR INSERT STATEMENT. MOVE 1 TO FIELD1 OF DATA-TO-BE-INS-OR-SEL. MOVE 1 TO FIELD2 OF DATA-TO-BE-INS-OR-SEL. SET REQUEST-INDEX TO 1. MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF. MOVE ZERO TO DBCAREA-USING-DATA-LEN. PERFORM FETCH-THEN-IRQ UNTIL NUMBER-OF-SESSIONS = ZERO. PERFORM SEND-DONE-MSG. 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. IF REQUEST-TYPE(REQUEST-INDEX) = ’INSERT’ IF FIELD1 OF DATA-TO-BE-INS-OR-SEL < MAXROWS ADD +1 TO FIELD1 OF DATA-TO-BE-INS-OR-SEL ADD +1 TO FIELD2 OF DATA-TO-BE-INS-OR-SEL ELSE *** SET UP VALUES FOR NEXT STATEMENT (RESET KEY VALUE) MOVE 1 TO FIELD1 OF DATA-TO-BE-INS-OR-SEL MOVE ZERO TO DBCAREA-USING-DATA-LEN SET REQUEST-INDEX UP BY 1 MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF ELSE SET REQUEST-INDEX UP BY 1 MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF IF REQUEST-TYPE(REQUEST-INDEX) = ’INSERT’ MOVE DATA-LEN-INSERT TO DBCAREA-USING-DATA-LEN. *********************************************************** ***************** 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 MOVE ERROR-LEN TO TEXT-LEN MOVE ERROR-MSG TO VARMSG STRING VARMSG DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT IF LAST-REQUEST NOT = ’DROP’ GOBACK ELSE NEXT SENTENCE ELSE IF DBCAREA-FET-PARCEL-FLAVOR = FAILURE-TYPE MOVE FAILURE-LEN TO TEXT-LEN MOVE FAILURE-MSG TO VARMSG STRING VARMSG DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT IF LAST-REQUEST NOT = ’DROP’ GOBACK ELSE NEXT SENTENCE ELSE IF DBCAREA-FET-PARCEL-FLAVOR = RECORD-TYPE MOVE DATA-VALUE OF DATA-RECORD TO DATA-FIELD-DISPLAY STRING ’SUM OF FIELD I = ’, DATA-FIELD-DISPLAY DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT. ********************************************************** ***************** DISPLAY ERROR MESSAGE ********** DISP-ERROR. MOVE CLI-RETURN-CODE TO CLI-RETURN-DISPLAY MOVE DBCAREA-FUNC TO FUNC-DISPLAY STRING ’FUNCTION CODE = ’, FUNC-DISPLAY, ’RETURN CODE =’, CLI-RETURN-DISPLAY DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT. IF DBCAREA-MSG-LEN GREATER ZERO STRING DBCAREA-MSG-TEXT DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT. GOBACK. ************************************************************ ***************** INITIALIZE DBCAREA ********** DBC-INIT. CALL ’DBCHINI’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE NOT = 0 MOVE CLI-RETURN-CODE TO CLI-RETURN-DISPLAY STRING ’CLI RET. CODE AFTER INIT.= ’, CLI-RETURN-DISPLAY DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT STRING DBCAREA-MSG-TEXT DELIMITED BY SIZE INTO OUTPUT-TEXT PERFORM TERM-OUT 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 LOGON STRING CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-LOGON-PTR, LOGON-STRING. ****** SET UP LENGTH OF LOGON STRING MOVE LOGON-LEN TO DBCAREA-LOGON-LEN. ****** SET UP POINTER TO DBC/SQL STATEMENT. CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-SQL-PTR, REQUEST-BUF. ****** SET UP LENGTH OF DBC/SQL STATEMENT. MOVE INSERT-LEN TO DBCAREA-SQL-LEN. ****** SET UP POINTER TO USING DATA CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-USING-DATA-PTR, DATA-TO-BE-INS-OR-SE ****** 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-MAX-DATA-LEN. ************************************************************ * SET MOVE-MODE OPTION FOR COBOL PROGRAMS. * * * ************************************************************ MOVE ’N’ TO DBCAREA-LOC-MODE. ************************************************************ * SET ’Y’ FOR CRASH-WAIT OPTION. * * (TECHNIQUE USED BY THIS SAMPLE PROGRAM) * ************************************************************ MOVE ’Y’ TO DBCAREA-WAIT-ACROSS-CRASH. ************************************************************ * SET ’N’ FOR CRASH-TELL 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. ************************************************************ ************************************************************ IMS-GU. MOVE GET-UNIQUE TO FILL-FUNCTION. CALL ’CBLTDLI’ USING GET-UNIQUE, IOPCB, TERM-INPUT. IF IOPCB-STATUS = NO-MSG PERFORM EXIT-RTN. IF IOPCB-STATUS NOT = ’ ’ PERFORM STATUS-ERROR, PERFORM EXIT-RTN. EXIT-RTN. GOBACK. TERM-OUT. MOVE IN-SERT TO FILL-FUNCTION. CALL ’CBLTDLI’ USING IN-SERT, IOPCB, TERM-OUTPUT. IF IOPCB-STATUS NOT = ’ ’ MOVE IOPCB-STATUS TO FILL-STATUS, DISPLAY STATUS-CODE-MSG UPON CONSOLE, PERFORM EXIT-RTN. MOVE SPACES TO OUTPUT-TEXT. STATUS-ERROR. MOVE IOPCB-STATUS TO FILL-STATUS. MOVE CAR-RET TO CR-SC. MOVE STATUS-CODE-MSG TO OUTPUT-TEXT. MOVE 39 TO CHAR-COUNT. PERFORM TERM-OUT. SEND-DONE-MSG. MOVE CAR-RET TO CR-1. MOVE DONE-MSG1 TO OUTPUT-TEXT. MOVE 46 TO CHAR-COUNT. PERFORM TERM-OUT. MOVE CAR-RET TO CR-2. MOVE DONE-MSG2 TO OUTPUT-TEXT. MOVE 46 TO CHAR-COUNT. PERFORM TERM-OUT.