4.7.1 JSMDRTEXT
The JSMDIRECT program calls CL program JSMDRTEXT when the following life cycle events occur:
|
The JSMDRTEXT program reads the JSMDRTDTA data area to get any libraries that need to be added to the current CGI job before the JSMLSAEXT/LANSA program is called. Blank library entries are ignored.
By default the JSMDRTDTA data area is blank. During the initial LANSA install, the LANSA program and communication libraries are added to first two positions.
The data area is 2000 bytes in size and the layout is:
|
The source code for this exit program is stored in QCLSRC in the JSM library.
/* JSMDIRECT EXIT PROGRAM */
PGM PARM(&EVENT &SERVICE &SERVERHOST &HOST &PORT &REMOTEUSER &REMOTEADDR &CONTINUE &MESSAGE)
DCL VAR(&EVENT) TYPE(*CHAR) LEN(10)
DCL VAR(&SERVICE) TYPE(*CHAR) LEN(30)
DCL VAR(&SERVERHOST) TYPE(*CHAR) LEN(80)
DCL VAR(&HOST) TYPE(*CHAR) LEN(80)
DCL VAR(&PORT) TYPE(*CHAR) LEN(5)
DCL VAR(&REMOTEUSER) TYPE(*CHAR) LEN(30)
DCL VAR(&REMOTEADDR) TYPE(*CHAR) LEN(45)
DCL VAR(&CONTINUE) TYPE(*CHAR) LEN(1)
DCL VAR(&MESSAGE) TYPE(*CHAR) LEN(256)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBUSER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNUMBER) TYPE(*CHAR) LEN(6)
DCL VAR(&JOBCMD) TYPE(*CHAR) LEN(50)
DCL VAR(&JOBMSG) TYPE(*CHAR) LEN(100)
DCL VAR(&JOBCHGSTS) TYPE(*CHAR) LEN(7) VALUE(OK)
DCL VAR(&TMPLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TMPLIBPOS) TYPE(*DEC) LEN(5)
DCL VAR(&TMPLIBLIST) TYPE(*CHAR) LEN(2000)
MONMSG MSGID(CPF0000)
/* RETRIEVE LIBRARIES */
RTVDTAARA DTAARA(JSMDRTDTA (1 2000)) RTNVAR(&TMPLIBLIST)
/* CLEANUP ANY PREVIOUS LEFTOVER FAILED SCENARIOS */
CHGVAR VAR(&TMPLIBPOS) VALUE(1)
RMVLIB:
CHGVAR VAR(&TMPLIB) VALUE(%SST(&TMPLIBLIST &TMPLIBPOS 10))
IF (&TMPLIB *EQ ' ' ) THEN(GOTO ENDRMVLIB)
RMVLIBLE LIB(&TMPLIB)
RCVMSG MSGQ(*PGMQ)
CHGVAR VAR(&TMPLIBPOS) VALUE(&TMPLIBPOS + 10)
IF (&TMPLIBPOS *GE 2000) THEN(GOTO ENDRMVLIB)
GOTO RMVLIB
ENDRMVLIB:
IF COND(%SUBSTRING(&EVENT 1 3) *EQ 'ERR') THEN(DO)
/* LOG ERROR EVENT */
SNDPGMMSG MSG('------- JSMDIRECT ERROR -------')
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&EVENT)
SNDPGMMSG MSGID(&EVENT) MSGF(JSMMSGF)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&SERVICE)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&SERVERHOST)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&REMOTEUSER)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&REMOTEADDR)
SNDPGMMSG MSG('-------------------------------')
/* CREATE STRING - WRKJOB JOB(464971/QTMHHTTP/JSMINST) */
RTVJOBA JOB(&JOBNAME) USER(&JOBUSER) NBR(&JOBNUMBER)
CHGVAR VAR(&JOBCMD) VALUE('WRKJOB JOB(' *TCAT +
&JOBNUMBER *TCAT '/' *TCAT +
&JOBUSER *TCAT '/' *TCAT +
&JOBNAME *TCAT ')' )
CHGVAR VAR(&JOBMSG) VALUE('JSMDirect error, use command' *BCAT +
&JOBCMD)
/* SNDMSG MSG(&JOBMSG) TOUSR(*SYSOPR) */
GOTO END
ENDDO
IF COND(&EVENT *EQ 'ENTRY') THEN(DO)
/* DEFAULT VALUE FOR CONTINUE IS 'Y' */
/* CHGVAR VAR(&CONTINUE) VALUE('N') */
/* CHGVAR VAR(&MESSAGE) VALUE('I do not know you') */
/* GOTO END */
/* PREPARE JOB FOR CURRENT SERVICE */
/* CALL PGM(JSMCHGJOB) PARM(&JOBCHGSTS) */
IF COND(&JOBCHGSTS *NE 'OK') THEN(DO)
CHGVAR VAR(&JOBMSG) VALUE('Change job exception' *BCAT +
&JOBCHGSTS)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
ENDDO
/* ADD LIBRARIES FOR JSMLSAEXT AND LANSA CALL */
CHGVAR VAR(&TMPLIBPOS) VALUE(1)
ADDLIB:
CHGVAR VAR(&TMPLIB) VALUE(%SST(&TMPLIBLIST &TMPLIBPOS 10))
IF (&TMPLIB *EQ ' ' ) THEN(GOTO ENDADDLIB)
ADDLIBLE LIB(&TMPLIB)
RCVMSG MSGQ(*PGMQ)
CHGVAR VAR(&TMPLIBPOS) VALUE(&TMPLIBPOS + 10)
IF (&TMPLIBPOS *GE 2000) THEN(GOTO ENDADDLIB)
GOTO ADDLIB
ENDADDLIB:
GOTO END
ENDDO
IF COND(&EVENT *EQ 'EXIT') THEN(DO)
/* RESTORE JOB FOR NEXT SERVICE */
GOTO END
ENDDO
END: ENDPGM