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.