Example: COBOL code invoking Java

Figure 1 is an example of a modified DB2® sample phone application that uses COBOL code to invoke the "sayHello" Java™ method. Descriptions for each of the code blocks precede the example.

Figure 1 includes changes that were made in the sample program to provide an interface to Java. These changes are highlighted and are located in the following areas of the example:

A: Identification Division
B: Environment Division
C: Linkage Section
D: Main Program Routine
E: Updates Phone Numbers For Employees
F: Perform Rollback
G: Java Exception Check

Note: This sample was provided by DB2 , typically in hlq.sdsnsamp(DSN8BC3). For more details, see http://publib.boulder.ibm.com/infocenter/dzichelp/v2r2/topic/com.ibm.db29.doc/db2prodhome.htm

Figure 1. Example: COBOL DB2 phone application that invokes Java under z/OS® Batch Runtime (Part 1 of 10)

     IDENTIFICATION DIVISION.
     *-----------------------
  A  PROGRAM-ID. DSN8BC3 RECURSIVE.

     ****** DSN8BC3 - DB2 SAMPLE PHONE APPLICATION - COBOL - BATCH ***
     * *
     * MODULE NAME = DSN8BC3 *
     * *
     * DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION *
     * PHONE APPLICATION *
     * BATCH *
     * COBOL *
     * *
     *LICENSED MATERIALS - PROPERTY OF IBM *
     *5695-DB2 *
     *(C) COPYRIGHT 1982, 1995 IBM CORP. *
     * * *---------------------------------------------------------------*
     /
   
     ENVIRONMENT DIVISION.
     *--------------------
     CONFIGURATION SECTION.
     SPECIAL-NAMES. C01 IS TO-TOP-OF-PAGE.
     REPOSITORY.
 B   Class HelloJ is
     "com.ibm.zos.batch.container.test.HelloJ"
     Class JavaException is "java.lang.Exception"
     Class BCDTranHelper is 
     "com.ibm.batch.spi.UserControlledTransactionHelper".
     INPUT-OUTPUT SECTION.
     FILE-CONTROL.
     SELECT CARDIN
     ASSIGN TO DA-S-CARDIN.
     SELECT REPOUT
     ASSIGN TO UT-S-REPORT.

     DATA DIVISION.
     *-------------
     FILE SECTION.
     FD CARDIN
     RECORD CONTAINS 80 CHARACTERS
     BLOCK CONTAINS 0 RECORDS
     LABEL RECORDS ARE OMITTED.
     01 CARDREC PIC X(80).

     FD REPOUT
     RECORD CONTAINS 120 CHARACTERS
     LABEL RECORDS ARE OMITTED
     DATA RECORD IS REPREC.
     01 REPREC PIC X(120).

Figure 2. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 2 of 10)

     /
     WORKING-STORAGE SECTION.

     *****************************************************
     * STRUCTURE FOR INPUT *
     *****************************************************
     01 IOAREA.
     02 ACTION PIC X(01).
     02 LNAME PIC X(15).
     02 FNAME PIC X(12).
     02 ENO PIC X(06).
     02 NEWNO PIC X(04).
     02 FILLER PIC X(42).

     01 ex object reference JavaException. 
     *****************************************************
     * REPORT HEADER STRUCTURE *
     *****************************************************
     01 REPHDR1.
     02 FILLER PIC X(29)
     VALUE '-----------------------------'.
     02 FILLER PIC X(21)
     VALUE ' TELEPHONE DIRECTORY '.
     02 FILLER PIC X(29)
     VALUE '-----------------------------'.
     01 REPHDR2.
     02 FILLER PIC X(09) VALUE 'LAST NAME'.
     02 FILLER PIC X(07) VALUE SPACES.
     02 FILLER PIC X(10) VALUE 'FIRST NAME'.
     02 FILLER PIC X(03) VALUE SPACES.
     02 FILLER PIC X(08) VALUE 'INITIAL'.
     02 FILLER PIC X(07) VALUE 'PHONE'.
     02 FILLER PIC X(09) VALUE 'EMPLOYEE'.
     02 FILLER PIC X(05) VALUE 'WORK'.
     02 FILLER PIC X(04) VALUE 'WORK'.
     01 REPHDR3.
     02 FILLER PIC X(37) VALUE SPACES.
     02 FILLER PIC X(07) VALUE 'NUMBER'.
     02 FILLER PIC X(09) VALUE 'NUMBER'.
     02 FILLER PIC X(05) VALUE 'DEPT'.
     02 FILLER PIC X(05) VALUE 'DEPT'.
     02 FILLER PIC X(04) VALUE 'NAME'.

     *****************************************************
     * REPORT STRUCTURE *
     *****************************************************
     01 REPDATA.
     02 RLNAME PIC X(15).
     02 FILLER PIC X(01) VALUE SPACES.
     02 RFNAME PIC X(12).
     02 FILLER PIC X(04) VALUE SPACES.
     02 RMIDINIT PIC X(01).
     02 FILLER PIC X(04) VALUE SPACES.
     02 RPHONE PIC X(04).
     02 FILLER PIC X(03) VALUE SPACES.
     02 REMPNO PIC X(06).
     02 FILLER PIC X(03) VALUE SPACES.
     02 RDEPTNO PIC X(03).
     02 FILLER PIC X(02) VALUE SPACES.
     02 RDEPTNAME PIC X(36).

Figure 3. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 3 of 10)

     *****************************************************
     * WORKAREAS *
     *****************************************************
     01 LNAME-WORK.
     49 LNAME-WORKL PIC S9(4) COMP.
     49 LNAME-WORKC PIC X(15).
     01 FNAME-WORK.
     49 FNAME-WORKL PIC S9(4) COMP.
     49 FNAME-WORKC PIC X(12).
     77 INPUT-SWITCH PIC X VALUE 'Y'.
     88 NOMORE-INPUT VALUE 'N'.
     77 NOT-FOUND PIC S9(9) COMP VALUE +100.
     *****************************************************
     * VARIABLES FOR ERROR-HANDLING *
     *****************************************************
     01 ERROR-MESSAGE.
     02 ERROR-LEN PIC S9(4) COMP VALUE +960.
     02 ERROR-TEXT PIC X(120) OCCURS 10 TIMES
     INDEXED BY ERROR-INDEX.
     77 ERROR-TEXT-LEN PIC S9(9) COMP VALUE +120.

     77 W09-WAIT-TIME PIC S9(8) COMP VALUE 0005.
     77 W09-RESPONSE PIC S9(8) COMP VALUE 0000.

     *****************************************************
     * SQL INCLUDE FOR SQLCA *
     *****************************************************
     EXEC SQL INCLUDE SQLCA END-EXEC.

     *****************************************************
     * SQL DECLARATION FOR VIEW VPHONE *
     *****************************************************
     EXEC SQL DECLARE DSN8910.VPHONE TABLE
     (LASTNAME VARCHAR(15) NOT NULL,
     FIRSTNAME VARCHAR(12) NOT NULL,
     MIDDLEINITIAL CHAR(01) NOT NULL,
     PHONENUMBER CHAR(04) ,
     EMPLOYEENUMBER CHAR(06) NOT NULL,
     DEPTNUMBER CHAR(03) NOT NULL,
     DEPTNAME VARCHAR(36) NOT NULL)
     END-EXEC.

     *****************************************************
     * STRUCTURE FOR PHONE RECORD *
     *****************************************************
     01 PPHONE.
     02 LASTNAME.
     49 LASTNAMEL PIC S9(4) COMP.
     49 LASTNAMEC PIC X(15) VALUE SPACES.
     02 FIRSTNAME.
     49 FIRSTNAMEL PIC S9(4) COMP.
     49 FIRSTNAMEC PIC X(12) VALUE SPACES.
     02 MIDDLEINITIAL PIC X(01).
     02 PHONENUMBER PIC X(04).
     02 EMPLOYEENUMBER PIC X(06).
     02 DEPTNUMBER PIC X(03).
     02 DEPTNAME.
     49 DEPTNAMEL PIC S9(4) COMP.
     49 DEPTNAMEC PIC X(36) VALUE SPACES.
     *
     77 PERCENT-COUNTER PIC S9(4) COMP.

Figure 4. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 4 of 10)

     *****************************************************
     * SQL DECLARATION FOR VIEW VEMPLP *
     *****************************************************
     EXEC SQL DECLARE DSN8910.VEMPLP TABLE
     (EMPLOYEENUMBER CHAR(06) NOT NULL,
     PHONENUMBER CHAR(04) )
     END-EXEC.
     *****************************************************
     * SQL CURSORS *
     *****************************************************
     *** CURSOR LISTS ALL EMPLOYEE NAMES

     EXEC SQL DECLARE TELE1 CURSOR FOR
     SELECT *
     FROM DSN8910.VPHONE
     END-EXEC.

     *** CURSOR LISTS ALL EMPLOYEE NAMES WITH A PATTERN (%) OR (_)
     *** FOR LAST NAME

     EXEC SQL DECLARE TELE2 CURSOR FOR
     SELECT *
     FROM DSN8910.VPHONE
     WHERE LASTNAME LIKE :LNAME-WORK
     AND FIRSTNAME LIKE :FNAME-WORK
     END-EXEC.

     *** CURSOR LISTS ALL EMPLOYEES WITH A SPECIFIC
     *** LAST NAME

     EXEC SQL DECLARE TELE3 CURSOR FOR
     SELECT *
     FROM DSN8910.VPHONE
     WHERE LASTNAME = :LNAME
     AND FIRSTNAME LIKE :FNAME-WORK
     END-EXEC.
     /
     /****************************************************
     * FIELDS SENT TO MESSAGE ROUTINE *
     *****************************************************
     01 MAJOR PIC X(07) VALUE 'DSN8BC3'.

     01 MSGCODE PIC X(4).
 
     01 OUTMSG PIC X(69).

     01 MSG-REC1.
     02 OUTMSG1 PIC X(69).
     02 RETCODE PIC S9(9).

     01 MSG-REC2.
     02 OUTMSG2 PIC X(69).

 C   LINKAGE SECTION.
     COPY JNI. 

     PROCEDURE DIVISION.
     *------------------

Figure 5. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 5 of 10)

     *****************************************************
     * SQL RETURN CODE HANDLING *
     *****************************************************
     EXEC SQL WHENEVER SQLERROR GOTO DBERROR END-EXEC.
     EXEC SQL WHENEVER SQLWARNING GOTO DBERROR END-EXEC.
     EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.

     *****************************************************
     * MAIN PROGRAM ROUTINE *
     *****************************************************
     PROG-START.
     MOVE 0 to RETURN-CODE.
     SET ADDRESS OF JNIENV TO JNIENVPTR
     SET ADDRESS OF JNINATIVEINTERFACE TO JNIENV
 D   Invoke HelloJ "sayHello"
     Display "Returned from Java sayHello to MAIN"
     Perform ErrorCheck 
     * **OPEN FILES
     OPEN INPUT CARDIN
     OUTPUT REPOUT.

     * **GET FIRST INPUT
     READ CARDIN RECORD INTO IOAREA
     AT END MOVE 'N' TO INPUT-SWITCH.

     * **MAIN ROUTINE
     PERFORM PROCESS-INPUT
     UNTIL NOMORE-INPUT.
     PROG-END.
     * **CLOSE FILES
     CLOSE CARDIN
     REPOUT.

     GOBACK.

     *****************************************************
     * CREATE REPORT HEADING *
     * SELECT ACTION *
     *****************************************************
     PROCESS-INPUT.
     * **PRINT HEADING
     WRITE REPREC FROM REPHDR1
     AFTER ADVANCING TO-TOP-OF-PAGE.
     WRITE REPREC FROM REPHDR2
     AFTER ADVANCING 2 LINES.
     WRITE REPREC FROM REPHDR3.

     * **SELECT ACTION
     IF ACTION = 'L'
     PERFORM LIST-FUNCTION
     ELSE
     IF ACTION = 'U'
     PERFORM TELEPHONE-UPDATE

Figure 6. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 6 of 10)

     ELSE
     * **INVALID REQUEST
     * **PRINT ERROR MESSAGE
     MOVE '068E' TO MSGCODE
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG
     MOVE OUTMSG TO OUTMSG2
     WRITE REPREC FROM MSG-REC2
     AFTER ADVANCING 2 LINES.
     READ CARDIN RECORD INTO IOAREA
     AT END MOVE 'N' TO INPUT-SWITCH.
     /
     *****************************************************
     * DETERMINE FORM OF NAME USED TO LIST EMPLOYEES *
     *****************************************************
     LIST-FUNCTION.
     * **NO LAST NAME GIVEN
     IF LNAME = SPACES
     MOVE '%' TO LNAME.
     * **NO FIRST NAME GIVEN
     IF FNAME = SPACES
     MOVE '%' TO FNAME.
     * **LIST ALL EMPLOYEES
     IF LNAME = '*'
     PERFORM LIST-ALL
     ELSE
     * **UNSTRING LAST NAME
     UNSTRING LNAME
     DELIMITED BY SPACE
     INTO LNAME-WORKC
     COUNT IN LNAME-WORKL
     * **UNSTRING FIRST NAME
     UNSTRING FNAME
     DELIMITED BY SPACE
     INTO FNAME-WORKC
     COUNT IN FNAME-WORKL
     * **COUNT %'S
     MOVE ZERO TO PERCENT-COUNTER
     INSPECT LNAME
     TALLYING PERCENT-COUNTER FOR ALL '%'
     IF PERCENT-COUNTER > ZERO
     * **IF NO %'S THEN
     * **LIST SPECIFIC NAME(S)
     * **ELSE
     * **LIST GENERIC NAME(S)
     PERFORM LIST-GENERIC
     ELSE
     PERFORM LIST-SPECIFIC.
     /
     *****************************************************
     * LIST ALL EMPLOYEES *
     *****************************************************
     LIST-ALL.
     * **OPEN CURSOR
     EXEC SQL OPEN TELE1 END-EXEC
     * **GET EMPLOYEES
     EXEC SQL FETCH TELE1 INTO :PPHONE END-EXEC.

Figure 7. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 7 of 10)

     IF SQLCODE = NOT-FOUND
     * **NO EMPLOYEE FOUND
     * **PRINT ERROR MESSAGE
     MOVE '008I' TO MSGCODE
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG
     MOVE OUTMSG TO OUTMSG2
     WRITE REPREC FROM MSG-REC2
     AFTER ADVANCING 2 LINES
     ELSE
     * **LIST ALL EMPLOYEES
     PERFORM PRINT-AND-GET1
     UNTIL SQLCODE IS NOT EQUAL TO ZERO.

     * **CLOSE CURSOR
     EXEC SQL CLOSE TELE1 END-EXEC.

     PRINT-AND-GET1.
     PERFORM PRINT-A-LINE.
     EXEC SQL FETCH TELE1 INTO :PPHONE END-EXEC.
     /
     *****************************************************
     * LIST GENERIC EMPLOYEES *
     *****************************************************
     LIST-GENERIC.
     * **OPEN CURSOR
     EXEC SQL OPEN TELE2 END-EXEC.

     * **GET EMPLOYEES
     EXEC SQL FETCH TELE2 INTO :PPHONE END-EXEC.

     IF SQLCODE = NOT-FOUND
     * **NO EMPLOYEE FOUND
     * **PRINT ERROR MESSAGE
     MOVE '008I' TO MSGCODE
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG
     MOVE OUTMSG TO OUTMSG2
     WRITE REPREC FROM MSG-REC2
     AFTER ADVANCING 2 LINES
     ELSE
     * **LIST GENERIC EMPLOYEE(S)
     PERFORM PRINT-AND-GET2
     UNTIL SQLCODE IS NOT EQUAL TO ZERO.

     * **CLOSE CURSOR
     EXEC SQL CLOSE TELE2 END-EXEC.

     PRINT-AND-GET2.
     PERFORM PRINT-A-LINE.
     EXEC SQL FETCH TELE2 INTO :PPHONE END-EXEC.
     /
     *****************************************************
     * LIST SPECIFIC EMPLOYEES *
     *****************************************************
     LIST-SPECIFIC.
     * **OPEN CURSOR
     EXEC SQL OPEN TELE3 END-EXEC.

Figure 8. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 8 of 10)

     * **GET EMPLOYEES
     EXEC SQL FETCH TELE3 INTO :PPHONE END-EXEC.

     IF SQLCODE = NOT-FOUND
     * **NO EMPLOYEE FOUND
     * **PRINT ERROR MESSAGE
     MOVE '008I' TO MSGCODE
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG
     MOVE OUTMSG TO OUTMSG2
     WRITE REPREC FROM MSG-REC2
     AFTER ADVANCING 2 LINES
     ELSE
     * **LIST SPECIFIC EMPLOYEE(S)
     PERFORM PRINT-AND-GET3
     UNTIL SQLCODE IS NOT EQUAL TO ZERO.

     * **CLOSE CURSOR
     EXEC SQL CLOSE TELE3 END-EXEC.

     PRINT-AND-GET3.
     PERFORM PRINT-A-LINE.
     EXEC SQL FETCH TELE3 INTO :PPHONE END-EXEC.
     /
     *****************************************************
     * PRINT A LINE OF INFORMATION FROM DIRECTORY *
     *****************************************************
     PRINT-A-LINE.
     * **GET INFORMATION
     MOVE LASTNAMEC TO RLNAME.
     MOVE FIRSTNAMEC TO RFNAME.
     MOVE MIDDLEINITIAL TO RMIDINIT.
     MOVE PHONENUMBER OF PPHONE TO RPHONE.
     MOVE EMPLOYEENUMBER OF PPHONE TO REMPNO.
     MOVE DEPTNUMBER TO RDEPTNO.
     MOVE DEPTNAMEC TO RDEPTNAME.
     * **PRINT INFORMATION
     WRITE REPREC FROM REPDATA
     AFTER ADVANCING 2 LINES.

     MOVE SPACES TO LASTNAMEC
     FIRSTNAMEC
     DEPTNAMEC.
     /
     *****************************************************
     * UPDATES PHONE NUMBERS FOR EMPLOYEES *
     *****************************************************
     TELEPHONE-UPDATE.
     EXEC SQL UPDATE DSN8910.VEMPLP
     SET PHONENUMBER = :NEWNO
     WHERE EMPLOYEENUMBER = :ENO END-EXEC.
     IF SQLCODE = ZERO
     * **EMPLOYEE FOUND
     * **UPDATE SUCCESSFUL
     * **PRINT CONFIRMATION
     * **MESSAGE
 E   INVOKE BCDTranHelper "commit"
     DISPLAY "After the BCcommit"
     Perform ErrorCheck 
     MOVE '004I' TO MSGCODE
     ELSE
     * **NO EMPLOYEE FOUND
     * **UPDATE FAILED

Figure 9. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 9 of 10)

     * **PRINT ERROR MESSAGE
     MOVE '007E' TO MSGCODE.
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG.
     MOVE OUTMSG TO OUTMSG2.
     WRITE REPREC FROM MSG-REC2
     AFTER ADVANCING 2 LINES.
     /
     *****************************************************
     * SQL ERROR OCCURRED - GET ERROR MESSAGE *
     *****************************************************
     DBERROR.
     * **SQL ERROR
     * **PRINT ERROR MESSAGE
     MOVE '060E' TO MSGCODE
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG.
     MOVE OUTMSG TO OUTMSG1 OF MSG-REC1.
     MOVE SQLCODE TO RETCODE OF MSG-REC1.
     WRITE REPREC FROM MSG-REC1
     AFTER ADVANCING 2 LINES.
     CALL 'DSNTIAR' USING SQLCA ERROR-MESSAGE ERROR-TEXT-LEN.
     IF RETURN-CODE = ZERO
     PERFORM ERROR-PRINT VARYING ERROR-INDEX
     FROM 1 BY 1 UNTIL ERROR-INDEX GREATER THAN 10
     ELSE

     * **MESSAGE FORMAT
     * **ROUTINE ERROR
     * **PRINT ERROR MESSAGE
     MOVE '075E' TO MSGCODE
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG
     MOVE OUTMSG TO OUTMSG1 OF MSG-REC1
     MOVE RETURN-CODE TO RETCODE OF MSG-REC1
     WRITE REPREC FROM MSG-REC1
     AFTER ADVANCING 2 LINES.

     ***********************************************************
     * SQL RETURN CODE HANDLING WHEN PROCESSING CANNOT PROCEED *
     ***********************************************************
     EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
     EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.
     EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.

 F   * **PERFORM ROLLBACK
     INVOKE BCDTranHelper "rollback"
     DISPLAY "After the BCrollback"
     Perform ErrorCheck 

     IF SQLCODE = ZERO

     * **ROLLBACK SUCCESSFUL
     * **PRINT CONFIRMATION
     * **MESSAGE
     MOVE '053I' TO MSGCODE
     ELSE

     * **ROLLBACK FAILED
     * **PRINT ERROR MESSAGE
     MOVE '061E' TO MSGCODE.
     CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG.
     MOVE OUTMSG TO OUTMSG1 OF MSG-REC1.
     MOVE SQLCODE TO RETCODE OF MSG-REC1.
     WRITE REPREC FROM MSG-REC1
     AFTER ADVANCING 2 LINES.
     GO TO PROG-END.

Figure 10. Example: COBOL DB2 phone application that invokes Java under z/OS Batch Runtime (Part 10 of 10)

     *****************************************************
     * PRINT MESSAGE TEXT *
     *****************************************************
     ERROR-PRINT.
     WRITE REPREC FROM ERROR-TEXT (ERROR-INDEX)
     AFTER ADVANCING 1 LINE.

     *****************************************************
 G  * Java Exception Check *
     *****************************************************
     ErrorCheck.
     Compute RETCODE = 0
     Call ExceptionOccurred
     using by value JNIEnvPtr
     returning ex
     If ex not = null then
     Call ExceptionClear using by value JNIEnvPtr
     Display "Caught an unexpected exception"
     Invoke ex "printStackTrace"
     MOVE 99 to RETURN-CODE
     End-if.