4.7.1 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.
Error has occurred, program ending, EXIT event will not be called

 

 

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