一般にコマンド・パラメータの初期値は
PARM KWD(SAVOBJ) TYPE(*CHAR) LEN(5) RSTD(*YES) +
DFT(*BOTH) VALUES(*DFN *OBJ *BOTH) +
PROMPT(' オブジェトまたは定義 ')
のように DFTパラメータで定義しておけばよい。
しかし、ケースによっては固定値を初期値とするのではなく、プログラムによって
データ・ベースなどを検索したりして初期値を動的に与えたい場合がある。
例えば CHGPFM や CHGPGM はもとのオブジェクトの値が検索されて表示されることを
思い出して欲しい。
CRTPRTF コマンドで元の既存の値が検索されて表示されればどんなに便利であろうと
感じたことはないだろうか？
ここでは弊社製品として使用されている CHGFMT コマンド（物理ファイルの様式の変更）の
ソースを紹介する。
CHGFMTコマンドは物理ファイルのソースを変更しておいて CHGFMT を実行すれば関連する
論理ファイルも含めて物理ファイルの様式を変更してくれるコマンドである。
物理ファイルのデータもそのままに復元される。
例えば日付を６桁形式から８桁の形式にするにはDDSソースを８桁に変更して CHGFMTコマンドを
実行するとデータ・ベースのレイアウトが変更されるという具合である。
CHGFMT は最初に物理ファイルが指定されたときに物理ファイルの情報を検索してコマンド・プロンプトに
表示してくれる。
【 CHGFMTコマンド・ソース 】
0001.00 CMD PROMPT(' 物理ファイル様式の変更 ')
0002.00 PARM KWD(FILE) TYPE(FILE) KEYPARM(*YES) +
0003.00 PROMPT(' 物理ファイル ')
0004.00 FILE: QUAL TYPE(*NAME) LEN(10) SPCVAL((*ALL))
0005.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0006.00 SPCVAL((*LIBL)) PROMPT(' ライブラリー ')
0007.00 PARM KWD(FILLIB) TYPE(*NAME) LEN(10) DFT(*LIBL) +
0008.00 SPCVAL((*LIBL)) +
0009.00 PROMPT(' 置換えライブラリー ')
0010.00 PARM KWD(SRCFILE) TYPE(SRCFILE) +
0011.00 PROMPT(' 原始ファイル ')
0012.00 SRCFILE: QUAL TYPE(*NAME) LEN(10) DFT(QDDSSRC)
0013.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0014.00 SPCVAL((*LIBL)) PROMPT(' ライブラリー ')
0015.00 PARM KWD(SRCMBR) TYPE(*NAME) LEN(10) DFT(*FILE) +
0016.00 SPCVAL((*FILE)) +
0017.00 PROMPT(' 原始メンバー ')
0018.00 PARM KWD(RCDLEN) TYPE(*CHAR) LEN(5) +
0019.00 PROMPT('DDS がない場合のレコード長 ')
0020.00 PARM KWD(IGCDTA) TYPE(*CHAR) LEN(4) RSTD(*YES) +
0021.00 DFT(*NO) VALUES(*YES *NO) +
0022.00 PROMPT(' ユーザー指定の漢字データ ')
0023.00 PARM KWD(TEXT) TYPE(*CHAR) LEN(50) +
0024.00 DFT(*SRCMBRTXT) SPCVAL((*SRCMBRTXT) +
0025.00 (*BLANK)) +
0026.00 PROMPT(' テキスト '' 記述 ''')
0027.00 PARM KWD(MAXMBRS) TYPE(*CHAR) LEN(6) DFT(1) +
0028.00 SPCVAL((*NOMAX) (1)) +
0029.00 PROMPT(' メンバーの最大数 ')
0030.00 PARM KWD(MAINT) TYPE(*CHAR) LEN(6) RSTD(*YES) +
0031.00 DFT(*IMMED) VALUES(*IMMED *DLY *REBLD) +
0032.00 PROMPT(' アクセス・パスの保守 ')
0033.00 PARM KWD(SIZE) TYPE(*CHAR) LEN(1) DSPINPUT(*NO) +
0034.00 PROMPT(' メンバー・サイズ ')
0035.00 PARM KWD(INZ) TYPE(*CHAR) LEN(10) DFT(10000) +
0036.00 SPCVAL((*NOMAX 16777215)) PROMPT(' +
0037.00 初期レコード数 ')
0038.00 PARM KWD(ADDRCD) TYPE(*CHAR) LEN(5) PROMPT(' +
0039.00 増分レコード数 ')
0040.00 PARM KWD(MAXADD) TYPE(*CHAR) LEN(5) PROMPT(' +
0041.00 最大増分値 ')
0042.00 PARM KWD(CONTIG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
0043.00 DFT(*NO) VALUES(*YES *NO) +
0044.00 PROMPT(' 連続記憶域 ')
0045.00 PARM KWD(LVLCHK) TYPE(*CHAR) LEN(4) RSTD(*YES) +
0046.00 DFT(*NO) VALUES(*YES *NO) +
0047.00 PROMPT(' レコード様式レベルの検査 ')
0048.00 PARM KWD(AUT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
0049.00 DFT(*LIBCRTAUT) VALUES(*LIBCRTAUT *ALL +
0050.00 *CHANGE *EXCLUSE *USE) +
0051.00 PROMPT(' 権限 ')
【 解説 】
最初の、
PARM KWD(FILE) TYPE(FILE) KEYPARM(*YES) +
PROMPT(' 物理ファイル ')
の KEYPARM(*YES) に注目して欲しい。これによってコマンドは最初はこのパラメータだけが表示されて、
ユーザーが入力すると次のプロンプト一時変更プログラムが起動される。
CLP ソースはやや長いのでザッと目を通す程度でよい。
【 プロンプト一時変更プログラムのCLPソース 】
0001.00 PGM PARM(&CMDNAME &KEYPRM &STRING)
0002.00 /*---------------------------------------------------------*/
0003.00 /* CHGFMTCMD : CHGFMT 用プロンプト一時変更プログラム */
0004.00 /*---------------------------------------------------------*/
0005.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(80)
0006.00 DCL VAR(&CMDNAME) TYPE(*CHAR) LEN(20)
0007.00 DCL VAR(&KEYPRM) TYPE(*CHAR) LEN(20)
0008.00 DCL VAR(&KEYPRM1) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&KEYPRM2) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&CMD) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
0012.00 DCL VAR(&STRING) TYPE(*CHAR) LEN(5700)
0013.00 DCL VAR(&STRINGLEN) TYPE(*DEC) LEN(8 0) VALUE(268)
0014.00 DCL VAR(&BIN02) TYPE(*CHAR) LEN(2)
0015.00 DCL VAR(&BIN04) TYPE(*CHAR) LEN(4)
0016.00 DCL VAR(&FILLIB) TYPE(*CHAR) LEN(21) +
0017.00 VALUE('??FILLIB(')
0018.00 DCL VAR(&SRCFILE) TYPE(*CHAR) LEN(34) +
0019.00 VALUE(' ??SRCFILE(')
0020.00 DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(22) +
0021.00 VALUE(' ??SRCMBR(')
0022.00 DCL VAR(&RCDLEN) TYPE(*CHAR) LEN(17) +
0023.00 VALUE(' ??RCDLEN(')
0024.00 DCL VAR(&IGCDTA) TYPE(*CHAR) LEN(16) +
0025.00 VALUE(' ??IGCDTA(')
0026.00 DCL VAR(&TEXT) TYPE(*CHAR) LEN(60) +
0027.00 VALUE(' ??TEXT(''')
0028.00 DCL VAR(&MAXMBRS) TYPE(*CHAR) LEN(18) +
0029.00 VALUE(' ??MAXMBRS(')
0030.00 DCL VAR(&MAINT) TYPE(*CHAR) LEN(17) +
0031.00 VALUE(' ??MAINT(')
0032.00 DCL VAR(&SIZE) TYPE(*CHAR) LEN(09) +
0033.00 VALUE(' ??SIZE()')
0034.00 DCL VAR(&INZ) TYPE(*CHAR) LEN(19) +
0035.00 VALUE(' ??INZ(')
0036.00 DCL VAR(&ADDRCD) TYPE(*CHAR) LEN(17) +
0037.00 VALUE(' ??ADDRCD(')
0038.00 DCL VAR(&MAXADD) TYPE(*CHAR) LEN(17) +
0039.00 VALUE(' ??MAXADD(')
0040.00 DCL VAR(&CONTIG) TYPE(*CHAR) LEN(16) +
0041.00 VALUE(' ??CONTIG(')
0042.00 DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(16) +
0043.00 VALUE(' ??LVLCHK(')
0044.00 DCL VAR(&AUT) TYPE(*CHAR) LEN(19) +
0045.00 VALUE(' ??AUT(')
0046.00 DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
0047.00 DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
0048.00 DCL VAR(&SRCFIL) TYPE(*CHAR) LEN(10)
0049.00 DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(5)
0050.00 DCL VAR(&ADD) TYPE(*CHAR) LEN(10)
0051.00 DCL VAR(&ADDLIB) TYPE(*CHAR) LEN(10)
0052.00 DCL VAR(&ADDFIL) TYPE(*CHAR) LEN(10)
0053.00
0054.00 DCL VAR(&FLLIB) TYPE(*CHAR) LEN(10)
0055.00 DCL VAR(&SRCFIL) TYPE(*CHAR) LEN(10)
0056.00 DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
0057.00 DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
0058.00 DCL VAR(&LEN) TYPE(*CHAR) LEN(5)
0059.00 DCL VAR(&IGC) TYPE(*CHAR) LEN(4)
0060.00 DCL VAR(&TXT) TYPE(*CHAR) LEN(50)
0061.00 DCL VAR(&MAX) TYPE(*CHAR) LEN(6)
0062.00 DCL VAR(&MAIN) TYPE(*CHAR) LEN(6)
0063.00 DCL VAR(&IN) TYPE(*CHAR) LEN(10)
0064.00 DCL VAR(&INZREC) TYPE(*DEC) LEN(10 0)
0065.00 DCL VAR(&ADS) TYPE(*CHAR) LEN(5)
0066.00 DCL VAR(&ADDREC) TYPE(*DEC) LEN(5 0)
0067.00 DCL VAR(&MADD) TYPE(*CHAR) LEN(5)
0068.00 DCL VAR(&MAXK) TYPE(*DEC) LEN(5 0)
0069.00 DCL VAR(&CONTI) TYPE(*CHAR) LEN(4)
0070.00 DCL VAR(&LVL) TYPE(*CHAR) LEN(4)
0071.00 DCL VAR(&AU) TYPE(*CHAR) LEN(10)
0072.00 DCL VAR(&CPFERR) TYPE(*CHAR) LEN(7)
0073.00
0074.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0075.00 CHGVAR VAR(%BIN(&BIN04)) VALUE(&STRINGLEN)
0076.00 CHGVAR VAR(&BIN02) VALUE(%SST(&BIN04 03 02))
0077.00 CHGVAR VAR(&KEYPRM1) VALUE(%SST(&KEYPRM 01 10))
0078.00 CHGVAR VAR(&KEYPRM2) VALUE(%SST(&KEYPRM 11 10))
0079.00
0080.00 /* ************************************************ */
0081.00 /* ファイル属性の検索 */
0082.00 /* ************************************************ */
0083.00 PANELWKR/RTVFD FILE(&KEYPRM2/&KEYPRM1) FILLIB(&FLLIB) +
0084.00 SRCFIL(&SRCFIL) SRCLIB(&SRCLIB) +
0085.00 SRCMBR(&MBR) RCDLEN(&LEN) TEXT(&TXT) +
0086.00 MAXMBRS(&MAX) MAINT(&MAIN) INZSIZ(&IN) +
0087.00 ADDSIZ(&ADS) MAXADD(&MADD) CONTIG(&CONTI) +
0088.00 LVLCHK(&LVL) AUT(&AU) CPFERR(&CPFERR)
0089.00 IF COND(&CPFERR *NE ' ') THEN(GOTO +
0090.00 CMDLBL(ERROR))
0091.00 IF COND(&MAX *EQ '000000') THEN(DO)
0092.00 CHGVAR VAR(&MAX) VALUE('*NOMAX')
0093.00 ENDDO
0094.00 IF COND(%SST(&IN 1 5) *EQ '00000') THEN(DO)
0095.00 CHGVAR VAR(&IN) VALUE(%SST(&IN 6 5))
0096.00 ENDDO
0097.00 IF COND(%SST(&ADS 1 1) *EQ '0') THEN(DO)
0098.00 CHGVAR VAR(&ADS) VALUE(%SST(&ADS 2 4))
0099.00 ENDDO
0100.00 IF COND(&ADS *EQ '0000') THEN(DO)
0101.00 CHGVAR VAR(&ADS) VALUE(' ')
0102.00 ENDDO
0103.00 IF COND(%SST(&MADD 1 4) *EQ '0000') THEN(DO)
0104.00 CHGVAR VAR(&MADD) VALUE(%SST(&MADD 5 1))
0105.00 ENDDO
0106.00 IF COND(&MADD *EQ '0') THEN(DO)
0107.00 CHGVAR VAR(&MADD) VALUE(' ')
0108.00 ENDDO
0109.00 IF COND((&ADS *NE ' ') *AND (&MADD *NE ' ')) +
0110.00 THEN(DO)
0111.00 CHGVAR VAR(&INZREC) VALUE(&IN)
0112.00 CHGVAR VAR(&ADDREC) VALUE(&ADS)
0113.00 CHGVAR VAR(&MAXK) VALUE(&MADD)
0114.00 CHGVAR VAR(&INZREC) VALUE(&INZREC - (&ADDREC * +
0115.00 &MAXK))
0116.00 IF COND(&INZREC *EQ 0) THEN(DO)
0117.00 CHGVAR VAR(&INZREC) VALUE(10000)
0118.00 ENDDO
0119.00 CHGVAR VAR(&IN) VALUE(&INZREC)
0120.00 IF COND(%SST(&IN 1 5) *EQ '00000') THEN(DO)
0121.00 CHGVAR VAR(&IN) VALUE(%SST(&IN 6 5))
0122.00 ENDDO
0123.00 IF COND(&ADDREC *EQ 0) THEN(DO)
0124.00 CHGVAR VAR(&ADDREC) VALUE(1000)
0125.00 ENDDO
0126.00 IF COND(&MAXK *EQ 0) THEN(DO)
0127.00 ENDDO
0128.00 ENDDO
0129.00 IF COND((&ADS *EQ ' ') *AND (&MADD *EQ ' ')) +
0130.00 THEN(DO)
0131.00 IF COND(&IN *NE '*NOMAX') THEN(DO)
0132.00 CHGVAR VAR(&IN) VALUE('10000')
0133.00 CHGVAR VAR(&ADS) VALUE('1000')
0134.00 CHGVAR VAR(&MADD) VALUE('3')
0135.00 ENDDO
0136.00 ENDDO
0137.00 /* ************************************************ */
0138.00 /* 返信パラメータの作成 */
0139.00 /* ************************************************ */
0140.00 CHGVAR VAR(&FILLIB) VALUE(&FILLIB *TCAT &FLLIB *TCAT +
0141.00 ') ')
0142.00 CHGVAR VAR(&SRCFILE) VALUE(&SRCFILE *TCAT &SRCLIB +
0143.00 *TCAT '/' *TCAT &SRCFIL *TCAT ') ')
0144.00 CHGVAR VAR(&SRCMBR) VALUE(&SRCMBR *TCAT &MBR *TCAT +
0145.00 ') ')
0146.00 CHGVAR VAR(&RCDLEN) VALUE(&RCDLEN *TCAT &LEN *TCAT +
0147.00 ') ')
0148.00 CHGVAR VAR(&IGC) VALUE('*NO ')
0149.00 CHGVAR VAR(&IGCDTA) VALUE(&IGCDTA *TCAT &IGC *TCAT +
0150.00 ') ')
0151.00 CHGVAR VAR(&TEXT) VALUE(&TEXT *TCAT &TXT *TCAT +
0152.00 ''') ')
0153.00 CHGVAR VAR(&MAXMBRS) VALUE(&MAXMBRS *TCAT &MAX *TCAT +
0154.00 ') ')
0155.00 CHGVAR VAR(&MAINT) VALUE(&MAINT *TCAT &MAIN *TCAT +
0156.00 ') ')
0157.00 CHGVAR VAR(&INZ) VALUE(&INZ *TCAT &IN *TCAT +
0158.00 ') ')
0159.00 CHGVAR VAR(&ADDRCD) VALUE(&ADDRCD *TCAT &ADS *TCAT +
0160.00 ') ')
0161.00 CHGVAR VAR(&MAXADD) VALUE(&MAXADD *TCAT &MADD *TCAT +
0162.00 ') ')
0163.00 CHGVAR VAR(&CONTIG) VALUE(&CONTIG *TCAT &CONTI *TCAT +
0164.00 ') ')
0165.00 CHGVAR VAR(&LVLCHK) VALUE(&LVLCHK *TCAT &LVL *TCAT +
0166.00 ') ')
0167.00 CHGVAR VAR(&AUT) VALUE(&AUT *TCAT &AU *TCAT +
0168.00 ') ')
0169.00 /* ************************************************ */
0170.00 /* 返信ストリングの作成 */
0171.00 /* ************************************************ */
0172.00 CHGVAR VAR(&STRING) VALUE(&BIN02)
0173.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &FILLIB)
0174.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &SRCFILE)
0175.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &SRCMBR)
0176.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &RCDLEN)
0177.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &IGCDTA)
0178.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &TEXT)
0179.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &MAXMBRS)
0180.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &MAINT)
0181.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &SIZE)
0182.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &INZ)
0183.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &ADDRCD)
0184.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &MAXADD)
0185.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &CONTIG)
0186.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &LVLCHK)
0187.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &AUT)
0188.00
0189.00 RETURN
0190.00 CHGVAR VAR(&STRINGLEN) VALUE(0)
0191.00 CHGVAR VAR(%BIN(&BIN04)) VALUE(&STRINGLEN)
0192.00 CHGVAR VAR(&BIN02) VALUE(%SST(&BIN04 03 02))
0193.00 CHGVAR VAR(&STRING) VALUE(&BIN02)
0194.00 ERROR:
0195.00 RCVMSG RMV(*NO) MSG(&MSG)
0196.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0197.00 SNDPGMMSG MSGID(CPF0011) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
0198.00 ENDPGM
【 解説 】
最初の
PGM PARM(&CMDNAME &KEYPRM &STRING)
は、決められた形式であり &CMDNAME がコマンドの名前とライブラリーとして受け取られる。
&KEYPARM にはコマンドで KEYPARM(*YES) として指定した値が入っている。
返信ストリングとして、ユーザーは KEYPARM 以降のパラメータを
??FILE(QTRFIL/SHOHIN) ??LENGTH(132) ...
のような文字ストリングとして生成して戻すだけでよい。
エラーが発生したときのエラー・メッセージは CPF0011 と決められている。
CLPソースとして長かったがエッセンスはこれだけである。
このCLPをコンパイルしておいて、コマンドのコンパイルでも
CRTCMD CMD(MYLIB/MYCMD) PGM(MYLIB/MYCMDCL) SRCFILE(MYSRCLIB/QCMDSRC) PMTF ILE(MYLIB/MYMSGF) PMTOVRPGM(MYLIB/CHGFMTCMD) AUT(*ALL)
のようにしてプロンプト一時変更プログラムにこのCLP のオブジェクトを指定する。