$SET ooctrl"+p-f"
IDENTIFICATION DIVISION.
PROGRAM-ID. TIBX799.
AUTHOR. Jeff Chochon
DATE-WRITTEN. March 2008.
DATE-COMPILED.
******************************************************************
* PROGRAM NAME: TIBX799
*
* Utility to launch Java program with parameters from the
* online environment.
*
* Compiler directive ooctrl "+p-f" does two things:
* . Adds type information to invoke statements, which the COBOL runtime
* system needs to convert data correctly between the COBOL
* and Java domains
* . Prevents the compiler from folding method names it invokes to
* lower-case - Java method names are case-sensitive
*
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-PARMS-FILE
ASSIGN TO IPARMS.
SELECT STD-VAR-FILE
ASSIGN TO ISTDVAR.
Repository.
* $java$ is letting the MicroFocus runtime know that a java
* class is being loaded.
class tijx799_cobolclass as "$java$tijx799"
class JavaExceptionManager as "javaexpt"
class ExceptionManager as "exptnmgr"
class Callback as "callback"
class EntryCallback as "entrycll"
.
DATA DIVISION.
FILE SECTION.
FD INPUT-PARMS-FILE
LABEL RECORDS ARE OMITTED
BLOCK CONTAINS 0 CHARACTERS
DATA RECORD IS INPUT-PARMS-RECORD.
01 INPUT-PARMS-RECORD PIC X(100).
FD STD-VAR-FILE
LABEL RECORDS ARE OMITTED
BLOCK CONTAINS 0 CHARACTERS
DATA RECORD IS STD-VAR-RECORD.
01 STD-VAR-RECORD PIC I(80).
WORKING-STORAGE SECTION.
01 theInstance object reference.
01 wsCallback object reference.
01 r1 object reference.
01 r2 object reference.
01 INPUT-PARMS-REC PIC X(100).
01 MISC.
05 pgm-name pic x(8) value 'TIBX799:'.
05 work-fld pic x(10).
05 parm-eof-sw pic x.
88 parm-eof value 'Y'.
05 PARM-LEN PIC 9(3).
05 LEAD-SPACE PIC 9(3).
05 JAVA-ARG PIC X(1000).
05 JAVA-ARG-LN PIC 9(4) value 0.
05 I PIC 9(4).
05 IPR-LN PIC 9(4) value 100.
05 DELIM-FND-SW PIC X.
88 DELIM-FND-NO value 'N'.
88 DELIM-FND value 'Y'.
** SQL COMMUNICATIONS AREA
EXEC SQL
INCLUDE SQLCA
END-EXEC.
local-storage section.
01 filler pic x. *> dummy storage to allow the local entry
*> point to be used for the callback
linkage section.
01 lnkException object reference.
PROCEDURE DIVISION.
0000-MAINLINE.
PERFORM 1000-READ-PARMS THRU 1000-EXIT
* DISPLAY pgm-name 'Before COBOL database access'
* INITIALIZE SQLCODE.
* Adding SQL to this program makes cobjrun fail because it cannot find
* TIBX799.class.
* EXEC SQL
* SELECT 'Gotchca'
* INTO :work-fld
* FROM TIDMSG
* WHERE msg_text like 'No matching Catalog%'
* END-EXEC.
* IF (SQLCODE NOT = ZERO AND +100)
* DISPLAY pgm-name 'WEIRD SQLCODE = ' SQLCODE
* END-IF.
* DISPLAY pgm-name 'After SQL work-fld=' work-fld
* DISPLAY pgm-name 'After COBOL database access'
DISPLAY pgm-name 'Before invoke of Java'
invoke tijx799_cobolclass "new"
returning r1
invoke tijx799_cobolclass "new"
using JAVA-ARG returning r2
* invoke tijx799_cobolclass "finalize"
* returning tijx799_cobolclass
DISPLAY pgm-name 'After invoke of Java'
. 0000-EXIT.
GOBACK.
1000-READ-PARMS.
MOVE SPACES TO INPUT-PARMS-REC
MOVE 0 TO JAVA-ARG-LN
INITIALIZE JAVA-ARG
OPEN INPUT INPUT-PARMS-FILE.
PERFORM UNTIL PARM-EOF
READ INPUT-PARMS-FILE INTO INPUT-PARMS-REC
AT END Set parm-eof to true
END-READ
IF (NOT parm-eof)
COMPUTE LEAD-SPACE = 0
COMPUTE I = 1
SET DELIM-FND-NO TO TRUE
INSPECT FUNCTION REVERSE(INPUT-PARMS-REC)
TALLYING LEAD-SPACE FOR LEADING SPACE
COMPUTE PARM-LEN = FUNCTION LENGTH(INPUT-PARMS-REC)
MOVE '~' TO INPUT-PARMS-REC
(PARM-LEN - LEAD-SPACE + 1:1)
DISPLAY 'TIBX799 Parms='
INPUT-PARMS-REC(1:PARM-LEN - LEAD-SPACE)
PERFORM UNTIL (I >= IPR-LN) OR DELIM-FND
MOVE INPUT-PARMS-REC(I:1) TO
JAVA-ARG(JAVA-ARG-LN + I:1)
IF (INPUT-PARMS-REC(I:1) = '~')
SET DELIM-FND TO TRUE
ELSE
COMPUTE I = I + 1
END-IF
END-PERFORM
COMPUTE JAVA-ARG-LN = JAVA-ARG-LN + I
END-IF
END-PERFORM
CLOSE INPUT-PARMS-FILE.
DISPLAY 'TIBX799 JAVA-ARG=' JAVA-ARG
. 1000-EXIT.