4.7.2 JSMDRTEXT
The JSMDIRECT program calls CL program JSMDRTEXT when the following life cycle events occur:
|
ENTRY |
Program starts. |
|
EXIT |
Program finishes successfully. |
|
ERRnnnn |
where nnnn is a 4 digit number starting from 3000. |
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 shared libraries are added to first two positions.
The data area is 2000 bytes in size and the layout is:
|
1-10 |
Library (LANSA Program Library) |
|
11-10 |
Library (LANSA Shared Library) |
|
21-10 |
Library |
|
xx-10 |
Libraries... |
|
1991-10 |
Library |
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)
DCL VAR(&CTIME) TYPE(*CHAR) LEN(6)
DCL VAR(&REQUESTID) TYPE(*CHAR) LEN(24)
MONMSG MSGID(CPF0000)
/* RETRIEVE LIBRARIES */
RTVDTAARA DTAARA(JSMDRTDTA (1 2000)) RTNVAR(&TMPLIBLIST)
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 */
/* CALLSUBR SUBR(LOGSTR) */
CALLSUBR SUBR(ADDLIB)
GOTO END
ENDDO
IF COND(&EVENT *EQ 'EXIT') THEN(DO)
/* RESTORE JOB FOR NEXT SERVICE */
CALLSUBR SUBR(RMVLIB)
/* CALLSUBR SUBR(LOGEND) */
GOTO END
ENDDO
IF COND(%SUBSTRING(&EVENT 1 3) *EQ 'ERR') THEN(DO)
/* LOG ERROR */
CALLSUBR SUBR(LOGERR)
CALLSUBR SUBR(RMVLIB)
/* CALLSUBR SUBR(LOGEND) */
GOTO END
ENDDO
/* =================================================================== */
/* SUBROUTINES */
/* =================================================================== */
SUBR SUBR(LOGSTR)
/* REQUEST ID */
CALL PGM(GETREQID) PARM(&REQUESTID)
/* START TIME */
SNDPGMMSG MSG('============ START ============')
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)
CHGVAR VAR(&JOBMSG) VALUE('JSMDRTEXT START' *BCAT &CTIME)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&REQUESTID)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&SERVICE)
/* CALL PGM(JSMTRCENV) */
ENDSUBR
SUBR SUBR(LOGEND)
/* END TIME */
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CTIME)
CHGVAR VAR(&JOBMSG) VALUE('JSMDRTEXT END' *BCAT &CTIME)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&JOBMSG)
SNDPGMMSG MSG('============= END =============')
ENDSUBR
SUBR SUBR(ADDLIB)
/* 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(RTNSUBR)
ADDLIBLE LIB(&TMPLIB) POSITION(*LAST)
RCVMSG MSGQ(*PGMQ) /* CPF2104, CPF2110, CPF2196 CPF2197 */
CHGVAR VAR(&TMPLIBPOS) VALUE(&TMPLIBPOS + 10)
IF (&TMPLIBPOS *GE 2000) THEN(RTNSUBR)
GOTO ADDLIB
ENDSUBR
SUBR SUBR(RMVLIB)
/* REMOVE LIBRARIES */
CHGVAR VAR(&TMPLIBPOS) VALUE(1)
RMVLIB:
CHGVAR VAR(&TMPLIB) VALUE(%SST(&TMPLIBLIST &TMPLIBPOS 10))
IF (&TMPLIB *EQ ' ' ) THEN(RTNSUBR)
RMVLIBLE LIB(&TMPLIB)
RCVMSG MSGQ(*PGMQ) /* CPF2104, CPF2110, CPF2196 CPF2197 */
CHGVAR VAR(&TMPLIBPOS) VALUE(&TMPLIBPOS + 10)
IF (&TMPLIBPOS *GE 2000) THEN(RTNSUBR)
GOTO RMVLIB
ENDSUBR
SUBR SUBR(LOGERR)
/* 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 MESSAGE - 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) */
ENDSUBR
SUBR SUBR(CHGJOB)
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
ENDSUBR
END: ENDPGM