RPG

136. RPG でストリーム・ファイルを読み取るには

最新では IFSのストリーム・ファイルを取り扱うことも多くなっているが
CPYFRMSTMF などのコマンドを使って DB2/400 にコピーや復元を繰り返すのは
泥臭い方法でもあり、何より CPYFRMSTMF CPYTOSTMF 等の IFS関連のコマンド
まだまだバグが多く安心して使用することができない。
それでは RPG プログラムで直接、 IFSのストリーム・ファイル を処理することは
できないのであろうか ?

C/400 プログラムでないとストリーム・ファイルの入出力はできないのではないかと
あきらめている方に、今回、RPGで直接、ストリーム・ファイルを処理する方法を紹介しよう。

RPG プログラムでストリーム・ファイルを処理する方法は IBMマニュアルも含めて
どこにも紹介されていないが、実現は可能である。
ILE-RPG でも直接、 IFSSのストリーム・ファイルを読み取ることができるのである。
通常、 IFS に保管されているストリーム・ファイルは API : open, read, ... 等を
使ってC/400で読み取るのが普通であるが、ここでは RPG によって C/400関数
直接、起動して読み取る方法を紹介する。

米国ではこのような事例を紹介するときは RPG のフリーフォーマット形式の RPGソースを
紹介するのがほとんどであるが、国内では RPGフリーフォーマットは、それほどまだ
普及していないようであるので、わかりやすいように通常の固定形式の RPGソースを作成した。
従って C/400関数のプロト・タイプも自前で RPG の中で定義している。

0001.00 H DFTNAME(OPNSTMF) DATEDIT(*YMD/) BNDDIR('QC2LE')                       
0002.00 F**********  ストリーム・ファイルの読取り ***************************** 
0003.00 F*                                                                      
0004.00 F********************************************************************** 
0005.00 D OPEN            PR             4B 0 EXTPROC('open')                   
0006.00 D   PATH                          *   VALUE OPTIONS(*STRING)            
0007.00 D  OPT                           4B 0 VALUE                             
0008.00                                                                         
0009.00 D LSTAT           PR             4B 0 EXTPROC('lstat')                  
0010.00 D   FILE                          *   VALUE OPTIONS(*STRING)            
0011.00 D   INFO                          *   VALUE OPTIONS(*STRING)            
0012.00                                                                         
0013.00 D READ            PR             4B 0 EXTPROC('read')                   
0014.00 D  FILEID                        4B 0 VALUE                             
0015.00 D  FILBUF                         *   VALUE OPTIONS(*STRING)            
0016.00 D  FILSIZ                        4B 0 VALUE                             
0017.00                                                                         
0018.00 D CLOSE           PR             4B 0 EXTPROC('close')                  
0019.00 D  FILEID                        4B 0 VALUE                             
0020.00                                                                         
0021.00 D PERROR          PR             4B 0 EXTPROC('perror')             
0022.00 D   MSGTTL                        *   VALUE OPTIONS(*STRING)        
0023.00                                                                     
0024.00 D PRINTF          PR                  EXTPROC('printf')             
0025.00 D   STR1                          *   VALUE OPTIONS(*STRING)        
0026.00 D   STR2                          *   VALUE OPTIONS(*NOPASS)        
0027.00                                                                     
0028.00 D GETCHAR         PR                  EXTPROC('getchar')            
0029.00                                                                     
0030.00 D HTML            C                   CONST('/A001/INDEX.HTM')      
0031.00 D FILE            S            256A                                 
0032.00 D FILDES          S              4B 0 INZ(0)                        
0033.00 D TRUE            S              4B 0 INZ(0)                        
0034.00 D FALSE           S              4B 0 INZ(-1)                       
0035.00 D O_RDONLY        S              4B 0 INZ(1)                        
0036.00 D O_WRONLY        S              4B 0 INZ(2)                        
0037.00 D O_APPEND        S              4B 0 INZ(256)                      
0038.00 D O_CREAT         S              4B 0 INZ(8)                        
0039.00 D O_EXCL          S              4B 0 INZ(16)                       
0040.00 D O_TRUNC         S              4B 0 INZ(64)                       
0041.00 D NULL            S              1A   INZ(X'00')                    
0042.00                                                                   
0043.00 D*( ファイル属性 )                                                
0044.00 D INFO_P          S               *   INZ(%ADDR(INFO))            
0045.00 D INFO            DS           128                                
0046.00 D  ALLOCSIZ              45     48B 0                             
0047.00                                                                   
0048.00 D ASCBUF          DS          1024    BASED(TMPBUF)               
0049.00 D EBCBUF          S           1024                                
0050.00 D TMPBUF          S               *                               
0051.00 D TMPLEN          S              4B 0 INZ(0)                      
0052.00 D BYTE_RED        S              4B 0 INZ(0)                      
0053.00                                                                   
0054.00 C*( ファイルのオープン )                                          
0055.00 C                   MOVEL     HTML          FILE                  
0056.00 C                   CAT(P)    NULL:0        FILE                  
0057.00 C                   EVAL      FILDES = OPEN(FILE: O_RDONLY)       
0058.00 C*  ( オープン失敗 )                                              
0059.00 C     FILDES        IFEQ      FALSE                               
0060.00 C                   CALLP     PERROR('OPEN FAIL')                 
0061.00 C                   ELSE                                          
0062.00 C*  ( オープン成功 )                                              
0063.00 C                   CALLP     LSTAT(HTML: INFO_P)                       
0064.00 C                   EVAL      TMPLEN = ALLOCSIZ                         
0065.00 C                   EVAL      TMPBUF = %ALLOC(TMPLEN)                   
0066.00 C                   EVAL      BYTE_RED = READ(FILDES:TMPBUF:TMPLEN)     
0067.00 C                   CALLP     CLOSE(FILDES)                             
0068.00 C*  ( ストリームを EBCDIC に変換して表示する )                          
0069.00 C                   Z-ADD     BYTE_RED      BUFLEN                      
0070.00 C                   Z-ADD     BUFLEN        MAXOTL                      
0071.00 C*--------------------------------------------------------------------+ 
0072.00 C                   CALL      'QDCXLATE'                           99   
0073.00 C                   PARM                    BUFLEN            5 0       
0074.00 C                   PARM                    ASCBUF                      
0075.00 C                   PARM      'QTCPEBC   '  TBL              10         
0076.00 C                   PARM      'QUSRSYS   '  TBLLIB           10         
0077.00 C                   PARM                    EBCBUF                      
0078.00 C                   PARM                    MAXOTL            5 0       
0079.00 C                   PARM                    OUTLEN            5 0       
0080.00 C                   PARM      '*JPN '       KANJI            10         
0081.00 C                   PARM      'N'           SISO              1         
0082.00 C                   PARM      '*AE '        TRNSLT           10         
0083.00 C*--------------------------------------------------------------------+ 
0084.00 C                   CALLP     PRINTF(EBCBUF)                          
0085.00 C                   END                                               
0086.00 C                   CALLP     GETCHAR                                 
0087.00 C                   SETON                                        LR   
【 コンパイル 】
CRTRPGMOD QTEMP/OPNSTMF SRCFILE(MYSRCLIB/QRPGLESRC) AUT(*ALL)
CRTPGM    MYLIB/OPNSTMF MODULE(QTEMP/OPNSTMF) ACTGRP(*NEW) AUT(*ALL)
【 解説 】

ファイルのオープン関数 : open によって /A001/INDEX.HTM という IFS の
ストリーム・ファイル
をオープンしてから ファイルの属性を取得すると関数 : lstat によって、
このファイルが割り振られているサイズ ALLOCSIZ を取得している。
サイズ ALLOCSIZ が取得できたら、その大きさの変数 : TMPBUF %ALLOC によって動的に
割り振っている。

TMPBUF は元々、単なるポインターであるが %ALLOC によって、そのポインターから
サイズ分の変数領域を生成しているのである。
ストリーム・ファイルの大きさは一定ではないので初めにサイズを調べておいてから
読み取り関数 : read によってストリーム・ファイルを読み取るのである。
実際に読み取られたバイト数は BYTE_READ に保管される。

結果を表示するために コード変換 API: QDCXLATE によって ASCII から EBCDIC に変換して
C/400 の printf 関数によってストリーム・ファイルの内容を表示している。
printf 関数とは C/400 で頻繁に使用される標準出力の表示/印刷の関数である。
RPG で QHTTPSVR/QTMHCGI を使って CGI を開発した人であれば QtmhWrStout という何やら
難しい名前のプロシージャーを使うことになったはずだが 実は標準出力を行うには
QtmhWrStoutの代わりに C/400 の printf を上記のように使用するだけでよい。

このプログラムを十分、理解できるようになれば、RPGプログラマーであっても
C/400 にだけしか使用できないと思われていた、どのような API でも RPG で使用することが
できるようになるはずである。
参考までに上記を C/400 で記述したソース・コードを以下に紹介する。

0001.00 #include <stdio.h>                                                      
0002.00 #include <stdlib.h>                                                     
0003.00 #include <string.h>                                                     
0004.00 #include <fcntl.h>                                                      
0005.00                                                                         
0006.00 #define TRUE         0                                                  
0007.00 #define FALSE       -1                                                  
0008.00 void main(void){                                                        
0009.00    int fildes = FALSE;                                                  
0010.00    struct stat info;                                                    
0011.00    char* tmpbuf;                                                        
0012.00    long  tmplen, m_byte_red;                                            
0013.00                                                                         
0014.00    if((fildes = open("/A001/INDEX.HTM", O_RDONLY)) == FALSE){/* OPEN ER 
0015.00       perror("FAILED OPEN");                                            
0016.00       exit(0);                                                          
0017.00    }/* OPEN ERR */                                                      
0018.00    lstat("/A001/INDEX.HTM", &info);                                     
0019.00    tmplen = (int)info.st_allocsize;                                     
0020.00    tmpbuf = (char*)malloc(tmplen);                                      
0021.00    memset(tmpbuf, 0, sizeof(tmpbuf));           
0022.00    m_byte_red = read(fildes, tmpbuf, tmplen);   
0023.00    close(fildes);                               
0024.00    tmpbuf[m_byte_red] = 0x00;                   
0025.00    free(tmpbuf);                                
0026.00    printf("%sn", tmpbuf);                      
0027.00    getchar();                                   
0028.00 }                                               
【 コンパイル 】
CRTBNDC MYLIB/OPNSTMF SRCFILE(MYSRCLIB/QCSRC) AUT(*ALL)