RPG

271. RPG の中でオブジェクトの存在をチェックするには ?

RPG プログラム内で CHKOBJ などでオブジェクトの存在をチェックすることが
できるのだろうか ?
これに関しては意外と難しいのか海外の記事でも決め手のテクニックはない。

CLP の中では

CHKOBJ OBJ(QTRFIL/SHTEST) OBJTYPE(*FILE)
MONMSG  CPF9800	

または

MONMSG     MSGID(CPF0000) EXEC(GOTO ERROR)
  :
CHKOBJ OBJ(QTRFIL/SHTEST) OBJTYPE(*FILE)

のように使用する。
この CLP の MONMSG に相当する RPG の命令が MONITOR であり

MONITOR
   :
 ( CHKOBJ ... )
   :
ON-ERROR
   :
ENDMON

のように使用する。
従って MONITOR を使えばエラーがあれば検知して ON-ERROR
実行されるはずなので上記の ( CHKOBJ … )の部分に
QCMDXC や system 関数を使って実行すればエラー・モニターされるはずだと
いうことになるのだが、そうは行かない。
このことについても IBM 解説書には記述がないので実行してみるしかない。

MONITOR
  SYSTEM('CHKOBJ OBJ(QTRFIL/SHTEST) OBJTYPE(*FILE)')
'FOUND'       DSPLY
              LEAVESR
ON-ERROR
'NOT FOUND'   DSPLY
ENDMON

と記述しても MONITOR がエラーを検知することはない。
これは QCMDEXC で実行しても同じであり検出はできない。
なぜかというと SNDPGMMSG で送信されるスタックは *PRV であり
ひとつ上の上位のスタックである。
つまりエラー・メッセージは system 関数や QCMDEXC に送られるので
もうひとつ上の RPGプログラムまでは伝わらないのである。
( SNDPGMMSG ではなく QMHSNDPM によってスタックを指定すれば可能だが )

そこで MONITOR 〜 ON-ERROR のあいだに直接プログラムを CALL して
その呼ばれたプログラムから *ESCAPE メッセージを SNDPGMMSG で
戻せば RPG はそのプログラムのひとつ上のスタックになるので
MONITOR はエラーを検知する。

なれば QSYS の CHKOBJ を処理している QSYS のプログラム: QLICKOBJ
直接、実行すればよいのだが QSYS のプログラムを
コマンドを経由せずに直接、呼び出すと
「ドメイン・エラーが検出された」とのエラーとなって実行は許されない。
QLICKOBJ をユーザー・ライブラリーにコピーしてもよいのだが
(【注】 使用者がコピーして自分自身で使う場合は著作権法では許されている)
これくらいは自前で作った。
「CHKOBJを処理するCHKOBJCL」を参照して欲しい。

CHKOBJCL を使えば次のような RPG によって
オブジェクトの存在を検査することができる。

【 TESTCHK: CHKOBJ を行うサンプル・ソース】
        
0001.00 H DATEDIT(*YMD/) COPYRIGHT('(C) OfficeQuattrb Co,.Ltd Japan 2017-')     
0002.00 F********** RPG によるオブジェクト存在検査 **************************** 
0003.00 F*                                                                      
0004.00 F********************************************************************** 
0005.00 D OBJOBJLIB       DS                                                    
0006.00 D   OBJ                   1     10A                                     
0007.00 D   OBJLIB               11     20A                                     
0008.00                                                                         
0009.00 D AUT             DS                                                    
0010.00 D   KOSU                  1      2B 0 INZ(1)                            
0011.00 D   AUTR                  3    102    DIM(10)                           
0012.00                                                                         
0013.00 D CHKOBJ          C                   CONST('QUATTRO/CHKOBJCL')         
0014.00 C                   EXSR      CHECK                                     
0015.00 C                   SETON                                        LR     
0016.00 C******************************************************                 
0017.00 C     CHECK         BEGSR                                               
0018.00 C******************************************************                 
0019.00 C                   MONITOR                                             
0020.00 C                   MOVEL     'SHOHINZ   '  OBJ                         
0021.00 C                   MOVEL     'QTRFIL    '  OBJLIB                
0022.00 C                   MOVEL     '*NONE     '  AUTR(1)               
0023.00 C*----------------------------------------------------+           
0024.00 C                   CALL      CHKOBJ                              
0025.00 C                   PARM                    OBJOBJLIB             
0026.00 C                   PARM      '*FILE     '  OBJTYPE          10   
0027.00 C                   PARM      '*NONE     '  MBR              10   
0028.00 C                   PARM                    AUT                   
0029.00 C*----------------------------------------------------+           
0030.00 C     'FOUND '      DSPLY                   ANS               1   
0031.00 C                   ON-ERROR  *ALL                                
0032.00 C     'NOT FOUND'   DSPLY                   ANS               1   
0033.00 C                   ENDMON                                        
0034.00 C                   ENDSR                                         
【 CHKOBJCL: オブジェクトの存在を検査するCLP 】
0001.00              PGM        PARM(&OBJOBJLIB &OBJTYPE &MBR &AUT)     
0002.00 /*---------------------------------------------------------*/   
0003.00 /*    CHKOBJCL :    オブジェクトの存在チエック             */   
0004.00 /*---------------------------------------------------------*/   
0005.00              DCL        VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20)     
0006.00              DCL        VAR(&OBJ) TYPE(*CHAR) LEN(10)           
0007.00              DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)        
0008.00              DCL        VAR(&OBJTYPE) TYPE(*CHAR) LEN(7)        
0009.00              DCL        VAR(&OBJTYPEC) TYPE(*CHAR) LEN(8)       
0010.00              DCL        VAR(&MBR) TYPE(*CHAR) LEN(10)           
0011.00              DCL        VAR(&AUT) TYPE(*CHAR) LEN(102)          
0012.00              DCL        VAR(&AUTS) TYPE(*CHAR) LEN(2)           
0013.00              DCL        VAR(&AUTC) TYPE(*CHAR) LEN(100)         
0014.00              DCL        VAR(&AUT10) TYPE(*CHAR) LEN(10)         
0015.00              DCL        VAR(&AUT100) TYPE(*CHAR) LEN(100)       
0016.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)          
0017.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)          
0018.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)          
0019.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)       
0020.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)       
0021.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                 
0022.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)              
0023.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +           
0024.00                           VALUE('*ESCAPE   ')                         
0025.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +           
0026.00                           VALUE(X'000074') /* 2 進数  */              
0027.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +              
0028.00                           VALUE(X'00000000')                          
0029.00              DCL        VAR(&N) TYPE(*DEC) LEN(4 0)                   
0030.00              DCL        VAR(&POS) TYPE(*DEC) LEN(4 0) VALUE(3)        
0031.00              DCL        VAR(&POT) TYPE(*DEC) LEN(4 0) VALUE(1)        
0032.00              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))       
0033.00                                                                       
0034.00 /*( 環境の取得 )*/                                                    
0035.00              RTVJOBA    TYPE(&TYPE)                                   
0036.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */   
0037.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')              
0038.00              ENDDO      /*  バッチ  */                                
0039.00              ELSE       CMD(DO) /*  対話式  */                        
0040.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')              
0041.00              ENDDO      /*  対話式  */                                
0042.00                                                                       
0043.00 /*( パラメータの取得 )*/                                              
0044.00              CHGVAR     VAR(&OBJ) VALUE(%SST(&OBJOBJLIB 01 10))       
0045.00              CHGVAR     VAR(&OBJLIB) VALUE(%SST(&OBJOBJLIB 11 10))    
0046.00              IF         COND(%SST(&OBJTYPE 1 1) *EQ '*') THEN(DO)     
0047.00              CHGVAR     VAR(&OBJTYPEC) VALUE(&OBJTYPE)                
0048.00              ENDDO                                                    
0049.00              ELSE       CMD(DO)                                       
0050.00              CHGVAR     VAR(&OBJTYPEC) VALUE('*' *TCAT &OBJTYPE)      
0051.00              ENDDO                                                    
0052.00              CHGVAR     VAR(&AUTS) VALUE(%SST(&AUT 1 2))              
0053.00              IF         COND(%BIN(&AUTS) *GT 0) THEN(DO)              
0054.00              CHGVAR     VAR(&N) VALUE(1)                              
0055.00  LOOP:       CHGVAR     VAR(&AUT10) VALUE(%SST(&AUT &POS 10))         
0056.00              CHGVAR     VAR(%SST(&AUT100 &POT 10)) VALUE(&AUT10)      
0057.00              IF         COND(&N < %BIN(&AUTS)) THEN(DO)               
0058.00              CHGVAR     VAR(&N) VALUE(&N + 1)                         
0059.00              CHGVAR     VAR(&POS) VALUE(&POS + 10)                    
0060.00              CHGVAR     VAR(&POT) VALUE(&POT + 10)                    
0061.00              GOTO       LOOP                                          
0062.00              ENDDO                                                    
0063.00              ENDDO                                                     
0064.00                                                                        
0065.00 /*( CHKOBJ の検査 )*/                                                  
0066.00              CHKOBJ     OBJ(&OBJLIB/&OBJ) OBJTYPE(&OBJTYPEC) +         
0067.00                           MBR(&MBR) AUT(&AUT100)                       
0068.00              RETURN                                                    
0069.00                                                                        
0070.00  APIERR:                                                               
0071.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))           
0072.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))       
0073.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                 
0074.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')              
0075.00              GOTO       SNDMSG                                         
0076.00                                                                        
0077.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +            
0078.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +  
0079.00                           MSGFLIB(&MSGFLIB)                            
0080.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                  
0081.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +    
0082.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)            
0083.00              ENDDO                                                     
0084.00              ELSE       CMD(DO)                             
0085.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0086.00                           MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) + 
0087.00                           MSGTYPE(&MSGTYPE)                 
0088.00              ENDDO                                          
0089.00              ENDPGM