以下のライフ・サイクル・イベントが発生すると、JSMDIRECTプログラムはCLプログラムJSMDRTEXTを呼び出します。
|
JSMDRTEXTプログラムはJSMDRTDTAデータ・エリアを読み込み、JSMLSAEXT/LANSAプログラムが呼び出される前に現在のCGIジョブに追加する必要があるライブラリを取得します。ブランクのライブラリ・エントリーは無視されます。
省略値では、JSMDRTDTAデータ・エリアはブランクです。最初のLANSAインストールの際に、LANSAプログラム・ライブラリとコミュニケーション・ライブラリが最初の2つの位置に追加されます。
データ・エリアのサイズは2000バイトで、レイアウトは以下のようになります。
|
この終了プログラムのソース・コードは、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)
MONMSG MSGID(CPF0000)
/*ライブラリを取得する*/
RTVDTAARA DTAARA(JSMDRTDTA (1 2000)) RTNVAR(&TMPLIBLIST)
/*残っている以前の失敗したシナリオを消去する*/
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)
/*エラー・イベントのログを取得する*/
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('-------------------------------')
/*文字列を作成する - 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)
/*メッセージMSG(&JOBMSG)をユーザーに送信する(*SYSOPR) */
GOTO END
ENDDO
IF COND(&EVENT *EQ 'ENTRY') THEN(DO)
/* CONTINUEの省略値は'Y' */
/* CHGVAR VAR(&CONTINUE)の値('N') */
/* CHGVAR VAR(&MESSAGE)の値('I do not know you') */
/*終了*/
/*現在のサービスのジョブを準備する*/
/* 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
/* JSMLSAEXTとLANSA呼び出し用にライブラリを追加する*/
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)
/*次のサービスのジョブを復元する*/
GOTO END
ENDDO
END: ENDPGM