15. 変更のあったソースだけを SAVE するには？
AS/400 には、変更オブジェクト保管 : SAVCHGOBJ は用意されているが SAVCHGSRC はない。
株式会社オフィスクアトロ作成の SAVCHGSRC コマンドを紹介しよう。
SAVCHGSRC は例えば次のような使用法が可能だ。
- SE が遠隔地のエンドユーザーで何本かのプログラム・ソースなどを修正する。
- SE はジョブの終了を自分のオフィスへ連絡する。
- オフィスのアシスタントは SNA でエンドユーザーの AS/400 に接続して SAVCHGSRC で変更ソースを漏れなく抽出して SNDNETF を使ってオフィスへ変更原始を受信する。
このように正確で時間の節約になる原始の保守が容易になる。
ソースコード
【コマンド原始】
0001.00 CMD PROMPT(' 変更原始 MBR の保管 ')
0002.00 PARM KWD(SRCLIB) TYPE(*NAME) LEN(10) MIN(1) +
0003.00 PROMPT(' 原始 LIBRARY 名 ')
【CLP原始】
0001.00 PGM PARM(&SRCFILE &SRCLIB &CHGDTE &CHGTIM &DEV +
0002.00 &PRINT &TYPEADD)
0003.00 /*---------------------------------------------------------*/
0004.00 /* SAVCHGSRC : 変更原始 MBR の保管 */
0005.00 /*---------------------------------------------------------*/
0006.00 DCL &SRCFILE TYPE(*CHAR) LEN(10)
0007.00 DCL &SRCF TYPE(*CHAR) LEN(10)
0008.00 DCL &SRCLIB TYPE(*CHAR) LEN(10)
0009.00 DCL &CHGDTE TYPE(*CHAR) LEN(6)
0010.00 DCL &CHGTIM TYPE(*CHAR) LEN(6)
0011.00 DCL &DEV TYPE(*CHAR) LEN(6)
0012.00 DCL &PRINT TYPE(*CHAR) LEN(4)
0013.00 DCL &MSG TYPE(*CHAR) LEN(80)
0014.00 DCL &TYPEADD TYPE(*CHAR) LEN(4)
0015.00 DCL &TOLABEL TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&MBRSU) TYPE(*DEC) LEN(4 0)
0017.00 DCL VAR(&MBRSUR) TYPE(*CHAR) LEN(4)
0018.00 DCL &MS1 TYPE(*CHAR) LEN(20)
0019.00 DCL &ANS TYPE(*CHAR) LEN(4)
0020.00 DCL VAR(&NBR) TYPE(*DEC) LEN(4 0)
0021.00 DCLF FILE(QTEMP/DSPFD)
0022.00 /*----( SAVE であれば LIBR.QTEMP を作成 )-------------------*/
0023.00 CRTSRCPF FILE(QTEMP/SAVSRCF) IGCDTA(*YES) +
0024.00 TEXT('SAVE 用一時 SRC FILE') AUT(*ALL)
0025.00 MONMSG MSGID(CPF7302) EXEC(DO)
0026.00 RMVM FILE(QTEMP/SAVSRCF) MBR(*ALL)
0027.00 MONMSG CPF7301
0028.00 ENDDO
0029.00 IF COND(&DEV *EQ 'SNDSRC') THEN(DO)
0030.00 RMVM FILE(SNDSRC/QRPGSRC) MBR(*ALL)
0031.00 MONMSG CPF7301
0032.00 RMVM FILE(SNDSRC/QDDSSRC) MBR(*ALL)
0033.00 MONMSG CPF7301
0034.00 RMVM FILE(SNDSRC/QCMDSRC) MBR(*ALL)
0035.00 MONMSG CPF7301
0036.00 RMVM FILE(SNDSRC/QDSPSRC) MBR(*ALL)
0037.00 MONMSG CPF7301
0038.00 RMVM FILE(SNDSRC/QCLSRC) MBR(*ALL)
0039.00 MONMSG CPF7301
0040.00 RMVM FILE(SNDSRC/QPRTSRC) MBR(*ALL)
0041.00 MONMSG CPF7301
0042.00 RMVM FILE(SNDSRC/QFMTSRC) MBR(*ALL)
0043.00 MONMSG CPF7301
0044.00 RMVM FILE(SNDSRC/QTXTSRC) MBR(*ALL)
0045.00 MONMSG CPF7301
0046.00 RMVM FILE(SNDSRC/QRDASRC) MBR(*ALL)
0047.00 MONMSG CPF7301
0048.00 ENDDO
0049.00 /*----( *ALL の SAVE ? )------------------------------------*/
0050.00 IF COND(&SRCFILE *EQ '*ALL ') THEN(DO)
0051.00 CHGVAR VAR(&SRCF) VALUE('QDDSSRC ')
0052.00 ENDDO
0053.00 IF COND(&SRCFILE *NE '*ALL ') THEN(DO)
0054.00 CHGVAR VAR(&SRCF) VALUE(&SRCFILE)
0055.00 ENDDO
0056.00 /*----( DSPFD : 原始 FILE の MBR LIST )------------------*/
0057.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0058.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0059.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0060.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0061.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD)
0062.00 MONMSG MSGID(CPF3012 CPF3061)
0063.00 ALL:
0064.00 IF COND(&SRCFILE *EQ '*ALL ') THEN(DO)
0065.00 QPRTSRC: CHGVAR VAR(&SRCF) VALUE('QPRTSRC ')
0066.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0067.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0068.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0069.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0070.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) +
0071.00 OUTMBR(*FIRST *ADD)
0072.00 MONMSG MSGID(CPF3012 CPF3061)
0073.00 QFMTSRC: CHGVAR VAR(&SRCF) VALUE('QFMTSRC ')
0074.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0075.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0076.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0077.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0078.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) +
0079.00 OUTMBR(*FIRST *ADD)
0080.00 MONMSG MSGID(CPF3012 CPF3061)
0081.00 QDSPSRC: CHGVAR VAR(&SRCF) VALUE('QDSPSRC ')
0082.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0083.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0084.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0085.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0086.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) +
0087.00 OUTMBR(*FIRST *ADD)
0088.00 MONMSG MSGID(CPF3012 CPF3061)
0089.00 QCLSRC: CHGVAR VAR(&SRCF) VALUE('QCLSRC ')
0090.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0091.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0092.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0093.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0094.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) +
0095.00 OUTMBR(*FIRST *ADD)
0096.00 MONMSG MSGID(CPF3012 CPF3061)
0097.00 QCMDSRC: CHGVAR VAR(&SRCF) VALUE('QCMDSRC ')
0098.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0099.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0100.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0101.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0102.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) +
0103.00 OUTMBR(*FIRST *ADD)
0104.00 MONMSG MSGID(CPF3012 CPF3061)
0105.00 QRPGSRC: CHGVAR VAR(&SRCF) VALUE('QRPGSRC ')
0106.00 CHGVAR VAR(&MS1) VALUE(&SRCLIB *CAT &SRCF)
0107.00 SNDPGMMSG MSGID(USR1019) MSGF(QSROAD/SRMSG) +
0108.00 MSGDTA(&MS1) TOPGMQ(*EXT) MSGTYPE(*STATUS)
0109.00 DSPFD FILE(&SRCLIB/&SRCF) TYPE(*MBRLIST) +
0110.00 OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) +
0111.00 OUTMBR(*FIRST *ADD)
0112.00 MONMSG MSGID(CPF3012 CPF3061)
0113.00 ENDDO
0114.00 RMVMSG CLEAR(*ALL)
0115.00 IF COND((&DEV *NE '*NONE ') & (&DEV *NE +
0116.00 'SNDSRC')) THEN(DO)
0117.00 CHECK: SNDUSRMSG MSG('TAPE または DISKET は正く装填されていま +
0118.00 すか ? ( Y/N )') VALUES('Y ' 'N ') +
0119.00 MSGTYPE(*INQ) TOMSGQ(*EXT) MSGRPY(&ANS)
0120.00 IF COND(&ANS *EQ 'N ') THEN(DO)
0121.00 SNDUSRMSG MSG('TAPE または DISKET を正しく装填して下さ +
0122.00 い ') MSGTYPE(*INFO) TOMSGQ(*EXT)
0123.00 GOTO CHECK
0124.00 ENDDO
0125.00 IF COND(&ANS *NE 'Y ') THEN(DO)
0126.00 SNDUSRMSG MSG(' 応答が正しくない。 YES のときは Y で NO+
0127.00 のときは N で応えなさい ') MSGTYPE(*INFO) +
0128.00 TOMSGQ(*EXT)
0129.00 GOTO CHECK
0130.00 ENDDO
0131.00 ENDDO
0132.00 /*----( DSPFD.QTEMP を READ して変更日付を検索する )--------*/
0133.00 READ: RCVF RCDFMT(QWHFDML)
0134.00 MONMSG MSGID(CPF0886)
0135.00 MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(PRINT))
0136.00 IF COND(&MLCHGD *LT &CHGDTE) THEN(GOTO +
0137.00 CMDLBL(READ))
0138.00 IF COND(&MLCHGD *EQ &CHGDTE) THEN(DO)
0139.00 IF COND(&MLCHGT *LT &CHGTIM) THEN(GOTO +
0140.00 CMDLBL(READ))
0141.00 ENDDO
0142.00 CHGVAR VAR(&MBRSU) VALUE(&MBRSU + 1)
0143.00 /*---( COPY QRPGSRC ---> SAVSRCF.QTEMP )-------*/
0144.00 IF COND(&DEV *EQ 'SNDSRC') THEN(DO)
0145.00 CPYSRCF FROMFILE(&SRCLIB/&MLFILE) +
0146.00 TOFILE(SNDSRC/&MLFILE) FROMMBR(&MLNAME) +
0147.00 MBROPT(*REPLACE)
0148.00 GOTO READ
0149.00 SNDEND: ENDDO
0150.00 IF COND(&TYPEADD *EQ '*NO ') THEN(DO)
0151.00 CPYSRCF FROMFILE(&SRCLIB/&MLFILE) +
0152.00 TOFILE(QTEMP/SAVSRCF) FROMMBR(&MLNAME)
0153.00 ENDDO
0154.00 IF COND(&TYPEADD *EQ '*YES') THEN(DO)
0155.00 IF COND(&MLSEU *EQ ' ') THEN(DO)
0156.00 IF COND(&MLFILE *EQ 'QRPGSRC ') THEN(DO)
0157.00 CHGVAR VAR(&MLSEU) VALUE('RPG ')
0158.00 ENDDO
0159.00 IF COND(&MLFILE *EQ 'QDSPSRC ') THEN(DO)
0160.00 CHGVAR VAR(&MLSEU) VALUE('DSP ')
0161.00 ENDDO
0162.00 IF COND(&MLFILE *EQ 'QCLSRC ') THEN(DO)
0163.00 CHGVAR VAR(&MLSEU) VALUE('CLP ')
0164.00 ENDDO
0165.00 IF COND(&MLFILE *EQ 'QCMDSRC ') THEN(DO)
0166.00 CHGVAR VAR(&MLSEU) VALUE('CMD ')
0167.00 ENDDO
0168.00 IF COND(&MLFILE *EQ 'QDDSSRC ') THEN(DO)
0169.00 CHGVAR VAR(&MLSEU) VALUE('LF ')
0170.00 ENDDO
0171.00 ENDDO
0172.00 IF COND(&MLSEU *EQ 'DSPF') THEN(DO)
0173.00 CHGVAR VAR(&MLSEU) VALUE('DSP ')
0174.00 ENDDO
0175.00 CHGVAR VAR(&TOLABEL) VALUE(&MLSEU *TCAT &MLNAME)
0176.00 CPYSRCF FROMFILE(&SRCLIB/&MLFILE) TOFILE(QTEMP/SAVSRCF) +
0177.00 FROMMBR(&MLNAME) TOMBR(&TOLABEL)
0178.00 ENDDO
0179.00 SAVE: IF COND(&DEV *EQ 'TAP01 ') THEN(DO)
0180.00 CHGVAR VAR(&NBR) VALUE(&NBR + 1)
0181.00 CPYTOTAP FROMFILE(QTEMP/SAVSRCF) TOFILE(QTAPE) +
0182.00 FROMMBR(&TOLABEL) TOSEQNBR(&NBR) +
0183.00 TODEV(TAP01) TOENDOPT(*LEAVE)
0184.00 MONMSG MSGID(CPF6801)
0185.00 ENDDO
0186.00 IF COND(&DEV *EQ 'DKT01 ') THEN(DO)
0187.00 CPYTODKT FROMFILE(QTEMP/SAVSRCF) TOFILE(QDKT) +
0188.00 FROMMBR(&TOLABEL) TODEV(DKT01)
0189.00 MONMSG MSGID(CPF6801)
0190.00 ENDDO
0191.00 GOTO READ
0192.00 PRINT:
0193.00 IF COND(&PRINT *EQ '*YES') THEN(DO)
0194.00 OVRDBF FILE(DSPFD) TOFILE(QTEMP/DSPFD)
0195.00 CALL PGM(QSROAD/PRTMBR) PARM(&CHGDTE &CHGTIM)
0196.00 DLTOVR *ALL
0197.00 ENDDO
0198.00 CHGVAR VAR(&MBRSUR) VALUE(&MBRSU)
0199.00 SNDPGMMSG MSG(&MBRSUR *TCAT ' 個の MBR が LIBRARY:' *TCAT +
0200.00 &SRCLIB *TCAT ' より抜粋された ') MSGTYPE(*DIAG)
0201.00 ENDSEU: RETURN
0202.00 RCVMSG: RCVMSG RMV(*NO) MSG(&MSG)
0203.00 SNDPGMMSG MSG(&MSG)
0204.00 RETURN
0205.00 ENDPGM
