以下のライフ・サイクル・イベントが発生すると、JSMDIRECTプログラムはCLプログラムJSMDRTEXTを呼び出します。
ENTRY | プログラムが開始します。 |
EXIT | プログラムが正常に終了します。 |
ERRnnnn | nnnnは、3000で始まる4桁の数字です。 |
JSMDRTEXTプログラムはJSMDRTDTAデータ・エリアを読み込み、JSMLSAEXT/LANSAプログラムが呼び出される前に現在のCGIジョブに追加する必要があるライブラリを取得します。ブランクのライブラリ・エントリーは無視されます。
デフォルトでは、JSMDRTDTAデータ・エリア、はブランクです。最初の LANSA インストール時に、LANSA プログラムと共用ライブラリが最初の 2 つの位置に追加されます。
データ・エリアのサイズは2000バイトで、レイアウトは以下のようになります。
1-10 | ライブラリ (LANSAプログラム・ライブラリ) |
11-10 | ライブラリ (LANSA共有・ライブラリ) |
21-10 | ライブラリ |
xx-10 | ライブラリ... |
1991-10 | ライブラリ |
この終了プログラムのソース・コードは、JSMライブラリのQCLSRCに保管されます。
/* JSMDIRECT 終了プログラム */
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)
/* ライブラリを取得 */
RTVDTAARA DTAARA(JSMDRTDTA (1 2000)) RTNVAR(&TMPLIBLIST)
IF COND(&EVENT *EQ 'ENTRY') THEN(DO)
/ CONTINUE のデフォルト値は 'Y' /
/* CHGVAR VAR(&CONTINUE) VALUE('N') */
/* CHGVAR VAR(&MESSAGE) VALUE('I do not know you') */
/* GOTO END */
/ *現在のサービスのジョブを準備 */
/* CALLSUBR SUBR(LOGSTR) */
CALLSUBR SUBR(ADDLIB)
GOTO END
ENDDO
IF COND(&EVENT *EQ 'EXIT') THEN(DO)
/ *次のサービスのジョブを復元 */
CALLSUBR SUBR(RMVLIB)
/* CALLSUBR SUBR(LOGEND) */
GOTO END
ENDDO
IF COND(%SUBSTRING (&EVENT 1 3) *EQ 'ERR') THEN(DO)
/ *エラー・のログ */
CALLSUBR SUBR(LOGERR)
CALLSUBR SUBR(RMVLIB)
/* CALLSUBR SUBR(LOGEND) */
GOTO END
ENDDO
/* =================================================================== */
/* サブルーチン */
/* =================================================================== */
SUBR SUBR(LOGSTR)
/* 要求 ID */
CALL PGM(GETREQID) PARM(&REQUESTID)
/* 開始時間 */
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)
/* 終了時間 */
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)
/* JSMLSAEXT と LANSA 呼び出し用のライブラリを追加 */
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)
/* ライブラリを除く */
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)
/ *エラー・イベントのログ */
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