Versions Compared

Key

  • This line was added.
  • This line was removed.
  • Formatting was changed.

以下のライフ・サイクル・イベントが発生すると、JSMDIRECTプログラムはCLプログラムJSMDRTEXTを呼び出します。

ENTRY

プログラムが開始します。

EXIT

プログラムが正常に終了します。

ERRnnnn

nnnnは、3000で始まる4桁の数字です。
エラーが発生すると、プログラムが終了し、EXITイベントは呼び出されません。

JSMDRTEXTプログラムはJSMDRTDTAデータ・エリアを読み込み、JSMLSAEXT/LANSAプログラムが呼び出される前に現在のCGIジョブに追加する必要があるライブラリを取得します。ブランクのライブラリ・エントリーは無視されます。

...

データ・エリアのサイズは2000バイトで、レイアウトは以下のようになります。

1-10

ライブラリ (LANSAプログラム・ライブラリ)

11-10

ライブラリ (LANSA共有・ライブラリ)

21-10

ライブラリ

xx-10

ライブラリ...

1991-10

ライブラリ

この終了プログラムのソース・コードは、JSMライブラリのQCLSRCに保管されます。

Code Block
/* 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