データ待ち行列: *DTAQ は読取るとその中身のデータは消えてしまう。
*DTAQ の実体はメモリであり厳密にいうと存在するオブジェクトではない。
そのため CRTDUPOBJ (オブジェクトのコピー)の対象ではなく
CRTDUPOBJ でコピーすることはできない。
そこでここでは CRTDUPOBJ の代わりに *DTAQ 内のデータを
別の *DTAQ にコピーするコマンド: CPYDTAQ を作ってみた。
CPYDTAQ の原理は簡単であり最初にコピー元の *DTAQ に登録されている
件数を API によって調べて、その同じ件数分だけコピー元の *DTAQ より
読み取ってコピー先の *DTAQ に出力する。
ただしコピー元の自分自身の *DTAQ にも同じ出力を行うのである。
*DTAQ は読取るとそのデータは消失してしまうので
読取った同じデータを読取り元の *DTAQ にも、もう一度保管しなおすのである。
このように読取り元の *DTAQ にも出力してやることによって
読取りによるデータ消失を防ぐことができる。
0001.00 CMD PROMPT(' データ待ち行列のコピー ')
0002.00 PARM KWD(FROMDTAQ) TYPE(FROMDTAQ) +
0003.00 PROMPT('FROM データ待ち行列 ')
0004.00 FROMDTAQ: QUAL TYPE(*NAME) LEN(10) MIN(1)
0005.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0006.00 SPCVAL((*LIBL) (*CURLIB)) +
0007.00 PROMPT(' ライブラリー ')
0008.00 PARM KWD(TOTAQ) TYPE(TODTAQ) +
0009.00 PROMPT('TO データ待ち行列 ')
0010.00 TODTAQ: QUAL TYPE(*NAME) LEN(10) MIN(1)
0011.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0012.00 SPCVAL((*LIBL) (*CURLIB)) +
0013.00 PROMPT(' ライブラリー ')
0014.00 PARM KWD(MBROPT) TYPE(*CHAR) LEN(8) RSTD(*YES) +
0015.00 DFT(*NONE) VALUES(*NONE *ADD *REPLACE) +
0016.00 PROMPT(' データの置き換えまたは追加 ')
0001.00 PGM PARM(&FROMDTQLIB &TODTQLIB &MBROPT)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* CPYDTAQCL : データ待ち行列のコピー */
0004.00 /* */
0005.00 /* 2017/06/17 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&FROMDTQLIB) TYPE(*CHAR) LEN(20)
0008.00 DCL VAR(&FROMDTQ) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&FROMLIB) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&TODTQLIB) TYPE(*CHAR) LEN(20)
0011.00 DCL VAR(&TODTQ) TYPE(*CHAR) LEN(10)
0012.00 DCL VAR(&TOLIB) TYPE(*CHAR) LEN(10)
0013.00 DCL VAR(&MBROPT) TYPE(*CHAR) LEN(8)
0014.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0015.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0016.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0019.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0020.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0021.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0022.00 VALUE('*ESCAPE ')
0023.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0024.00 VALUE(X'000074') /* 2 進数 */
0025.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0026.00 VALUE(X'00000000')
0027.00 /*( API : QMHQRDQD 用の変数 )*/
0028.00 DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(1024)
0029.00 DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4) VALUE(X'0400')
0030.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4)
0031.00 DCL VAR(&MSGLEN) TYPE(*DEC) LEN(8 0)
0032.00 DCL VAR(&KKMSU) TYPE(*DEC) LEN(8 0)
0033.00 DCL VAR(&N) TYPE(*DEC) LEN(8 0)
0034.00 DCL VAR(&WAIT) TYPE(*DEC) LEN(5 0) VALUE(0)
0035.00 DCL VAR(&MSGBUF) TYPE(*CHAR) LEN(4096)
0036.00 DCL VAR(&CHAR8) TYPE(*CHAR) LEN(8)
0037.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0038.00
0039.00 /*( 環境の取得 )*/
0040.00 RTVJOBA TYPE(&TYPE)
0041.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0042.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0043.00 ENDDO /* バッチ */
0044.00 ELSE CMD(DO) /* 対話式 */
0045.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0046.00 ENDDO /* 対話式 */
0047.00
0048.00 /*( パラメータの取得 )*/
0049.00 CHGVAR VAR(&FROMDTQ) VALUE(%SST(&FROMDTQLIB 01 10))
0050.00 CHGVAR VAR(&FROMLIB) VALUE(%SST(&FROMDTQLIB 11 10))
0051.00 CHGVAR VAR(&TODTQ) VALUE(%SST(&TODTQLIB 01 10))
0052.00 CHGVAR VAR(&TOLIB) VALUE(%SST(&TODTQLIB 11 10))
0053.00
0054.00 /*( 妥当性の検査 )*/
0055.00 IF COND(&MBROPT = '*NONE') THEN(DO)
0056.00 CHGVAR VAR(&MSG) +
0057.00 VALUE(' 置き換えまたは追加オプションが指定 +
0058.00 されていません。 ')
0059.00 GOTO SNDMSG
0060.00 ENDDO
0061.00
0062.00 /*( FROMDTAQ 属性の検索 )*/
0063.00 CALL PGM(QMHQRDQD) PARM(&RCVVAR &RCVLEN +
0064.00 'RDQD0100' &FROMDTQLIB)
0065.00 CHGVAR VAR(&BIN4) VALUE(%SST(&RCVVAR 9 4))
0066.00 CHGVAR VAR(&MSGLEN) VALUE(%BIN(&BIN4))
0067.00 CHGVAR VAR(&BIN4) VALUE(%SST(&RCVVAR 73 4))
0068.00 CHGVAR VAR(&KKMSU) VALUE(%BIN(&BIN4))
0069.00 IF COND(&KKMSU = 0) THEN(DO)
0070.00 CHGVAR VAR(&MSG) +
0071.00 VALUE(' コピー元のデータ待ち行列は空です。 ')
0072.00 GOTO SNDMSG
0073.00 ENDDO
0074.00
0075.00 /*( *REPLACE の場合はコピー先をクリヤー )*/
0076.00 IF COND(&MBROPT = '*REPLACE') THEN(DO)
0077.00 CALL PGM(QCLRDTAQ) PARM(&TODTQ &TOLIB)
0078.00 ENDDO
0079.00
0080.00 /*( FROMDTAQ の読取り )*/
0081.00 CHGVAR VAR(&N) VALUE(1)
0082.00 CHGVAR VAR(&WAIT) VALUE(0) /* 即時読取り */
0083.00 READ:
0084.00 CALL PGM(QRCVDTAQ) PARM(&FROMDTQ &FROMLIB &MSGLEN +
0085.00 &MSGBUF &WAIT)
0086.00 /*( TODTAQ への出力 )*/
0087.00 CALL PGM(QSNDDTAQ) PARM(&TODTQ &TOLIB &MSGLEN +
0088.00 &MSGBUF)
0089.00 /*( FROMDTAQ へも出力 )*/
0090.00 CALL PGM(QSNDDTAQ) PARM(&FROMDTQ &FROMLIB &MSGLEN +
0091.00 &MSGBUF)
0092.00 /*( LOOP へ戻る )*/
0093.00 IF COND(&N < &KKMSU) THEN(DO)
0094.00 CHGVAR VAR(&N) VALUE(&N + 1)
0095.00 GOTO READ
0096.00 ENDDO
0097.00 REDEND:
0098.00 /*( 完了メッセージ )*/
0099.00 CHGVAR VAR(&CHAR8) VALUE(&N)
0100.00 ZERO: IF COND(%SST(&CHAR8 1 1) *EQ '0') THEN(DO)
0101.00 CHGVAR VAR(&CHAR8) VALUE(%SST(&CHAR8 2 7))
0102.00 GOTO ZERO
0103.00 ENDDO
0104.00 CHGVAR VAR(&MSG) VALUE(&CHAR8 *TCAT +
0105.00 ' レコードをコピーしました。 ')
0106.00 CHGVAR VAR(&MSGTYPE) VALUE('*DIAG ')
0107.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0108.00 GOTO SNDMSG
0109.00 RETURN
0110.00
0111.00 APIERR:
0112.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0113.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0114.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0115.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0116.00 GOTO SNDMSG
0117.00
0118.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0119.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0120.00 MSGFLIB(&MSGFLIB)
0121.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0122.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0123.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0124.00 ENDDO
0125.00 ELSE CMD(DO)
0126.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0127.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0128.00 MSGTYPE(&MSGTYPE)
0129.00 ENDDO
0130.00 ENDPGM
この CLP は対話式環境またはバッチ処理のいずれの場合の実行も想定していて
バッチ式で実行した場合はエラー・メッセージは
*ESCAPE として QSYSOPR に出力される。
完了メッセージは *TOPGMQ に *DIAG として出力される。
まず最初に
0062.00 /*( FROMDTAQ 属性の検索 )*/ 0063.00 CALL PGM(QMHQRDQD) PARM(&RCVVAR &RCVLEN + 0064.00 'RDQD0100' &FROMDTQLIB)
によってコピー元の *DTAQ の属性を取得する。
0067.00 CHGVAR VAR(&BIN4) VALUE(%SST(&RCVVAR 73 4)) 0068.00 CHGVAR VAR(&KKMSU) VALUE(%BIN(&BIN4))
によってコピー元の件数: &KKMSU がわかるので、この回数分だけ
0083.00 READ: 0084.00 CALL PGM(QRCVDTAQ) PARM(&FROMDTQ &FROMLIB &MSGLEN + 0085.00 &MSGBUF &WAIT)
によって読取る。
コピー先へ
0086.00 /*( TODTAQ への出力 )*/ 0087.00 CALL PGM(QSNDDTAQ) PARM(&TODTQ &TOLIB &MSGLEN + 0088.00 &MSGBUF)
によって出力するとともにコピー元にも
0089.00 /*( FROMDTAQ へも出力 )*/ 0090.00 CALL PGM(QSNDDTAQ) PARM(&FROMDTQ &FROMLIB &MSGLEN + 0091.00 &MSGBUF)
によって出力しているのでコピー元にも、
この CLP の実行前に存在していた同じデータが保管されることになる。
つまりこれでコピー元とコピー先の *DTAQ には同じデータを作成することが
できたことになる。