データベース

41. XML-INTO でJSONを解析(3)

IFSストリーム・ファイルのJSONのXML-INTOによる処理に成功したので
今度はさらに何個のレコードを処理したのかがわかるように
%HANDLER という組込み関数を使う例を紹介しよう。
%HANDLER についてはRPG解説書にもある読んでもサッパリ意味不明な
解説よりこれから紹介する具体的なソース・サンプルを見たほうが
はるかにわかりやすいのとなるだろう。

これまでの XML-INTO の使用例では

 XML-INTO(RECORD, ....)

と第一パラメータにデータ構造(DS)の名前を指定したきたが
ここでは%HANDLERという組込み関数を指定することになる。
具体的には

 XML-INTO %HANDLER(recHandler:ALLOK) ....

のように %HANDLER に続く第一パラメータ recHandler は
プロシージャーの名前を指定すればこのプロシージャーが
N 回呼び出されて実行されることになる。
まずはソースを見てみよう。

[ %HANDLERのサンプル・ソース: TESTJSON2B ]

ソースはこちらから

0001.00 H DFTNAME(TESTJSON2B) DATEDIT(*YMD/) BNDDIR('QC2LE')                    
0002.00 H CCSID(*GRAPH:*SRC)                                                    
0003.00 F********** %HANDLER の例 ********************************************* 
0004.00 F*                                                                      
0005.00 F********************************************************************** 
0006.00                                                                         
0007.00  * CRTBNDRPG  OBJ(OBJLIB/TESTJSON2B) SRCFILE(MYSRCLIB/QRPGLESRC)        
0008.00  * DFTACTRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)                
0009.00                                                                         
0010.00  *-------------------------------------------------------------------*  
0011.00  *  2021/12/03 : 作成                                                   
0012.00  *-------------------------------------------------------------------*  
0013.00  /COPY QSYSINC/QRPGLESRC,IFS                                            
0014.00  ****************************************************                   
0015.00  *       プロシージャーのプロトタイプ宣言           *                   
0016.00  ****************************************************                   
0017.00 D*( JSON2XML のプロトタイプ宣言 )                                       
0018.00 D JSON2XML        PR            10I 0                                   
0019.00 D  JSON_P                         *   Value                             
0020.00 D  XML_P                          *   Value                             
0021.00 D  XMLEN_P                        *   Value                             
0022.00 D  OPTIONS                     128A   Value                             
0023.00                                                                         
0024.00 D recHandler      PR            10I 0                                    
0025.00 D    OK                           N                                      
0026.00 D    REC                              LIKEDS(RECORD) DIM(1) CONST        
0027.00 D    numRecs                    10U 0 VALUE                              
0028.00 D                                                                        
0029.00  *( 作業変数 )                                                           
0030.00 D XMLIFS          S            128A   INZ('/AS400-NET.USR/TEMP/TEST.JSN')
0031.00 D STAT_           DS                  LIKEDS(stat_t)                     
0032.00 D TRUE#           S             10I 0 INZ(0)                             
0033.00 D FALSE#          S             10I 0 INZ(-1)                            
0034.00 D JSON            S            512A                                      
0035.00 D XML             S          32763A                                      
0036.00 D UCS2            S          32763C   CCSID(1200)                        
0037.00 D MSG             S             80A                                      
0038.00 D XMLEN           S             10I 0                                    
0039.00 D ALLOK           S               N                                      
0040.00                                                                          
0041.00 D RECORD          DS                  QUALIFIED                          
0042.00 D   SHCODE                1     10A                                      
0043.00 D   SHNAME               11     34A                                      
0044.00 D   SHTANK               35     41S 0                                    
0045.00 D   SHSCOD               42     45A                                      
0046.00                                                                          
0047.00 D RCR             DS                  LIKEDS(RECORD) DIM(250)            
0048.00 D RC              S             10I 0 INZ(0)                                配列指標      
0049.00                                                                                           
0050.00  /FREE                                                                                    
0051.00    JSON2XML(%ADDR(XMLIFS): %ADDR(XML): %ADDR(XMLEN): 'doc=file'); //JSON を XML に変換する
0052.00    XML-INTO %HANDLER(recHandler:ALLOK)                                                    
0053.00        %XML(%UCS2(XML): 'path=file/record ccsid=ucs2 case=any doc=string');               
0054.00  /END-FREE                                                                                
0055.00 C                   SETON                                        LR                       
0056.00 C                   RETURN                                                                
0057.00  ************************************************************                             
0058.00  *   JSON2XML        : JSON を XML に変換する                                             
0059.00  ************************************************************                             
0060.00  *---( JSON2XML                  ここから )-----------------------*                       
0061.00  * JSON を XML に変換する                                                                 
0062.00 P JSON2XML        B                                                                       
0063.00 D                 PI            10I 0                                                     
0064.00 D  FILE_P                         *   Value                                               
0065.00 D  XML_P                          *   Value                                               
0066.00 D  XMLEN_P                        *   Value                                               
0067.00 D  OPTIONS                     128A   Value                                               
0068.00  *                                                                                        
0069.00  *( 作業変数 )                                                                            
0070.00 D FILE            S            128A   BASED(FILE_P)                                       
0071.00 D XML             S          32763A   BASED(XML_P)                                        
0072.00 D XMLEN           S             10I 0 BASED(XMLEN_P)    
0073.00 D FD              S             10I 0                   
0074.00 D JSON            S              1A   DIM(32763)        
0075.00 D OPTION          S            128A   BASED(OPTION_P)   
0076.00 D N               S             10I 0                   
0077.00 D LEN             S             10I 0                   
0078.00 D X               S              4S 0                   
0079.00 D FLD             S             10A                     
0080.00 D VALUE           S            256A                     
0081.00 D bFLD            S               N   INZ(*OFF)         
0082.00 D bVALUE          S               N   INZ(*OFF)         
0083.00 D bOE             S               N   INZ(*OFF)         
0084.00 D bRECORD         S               N   INZ(*OFF)         
0085.00 D bFILE           S               N   INZ(*OFF)         
0086.00 D OE              S              1A   INZ(X'0E')        
0087.00 D OF              S              1A   INZ(X'0F')        
0088.00 D CR              S              1A   INZ(X'0D')        
0089.00 D LF              S              1A   INZ(X'25')        
0090.00 D TMPBUF          S          32763A                     
0091.00 D TMPLEN          S             10I 0                   
0092.00 D BYTE_RED        S             10I 0                   
0093.00 D CCS5035         S             10I 0 INZ(5035)         
0094.00 D CCS1200         S             10I 0 INZ(1200)         
0095.00 D STAT            DS                  LIKEDS(stat_t)    
0096.00                                                                           
0097.00 C                   IF        %SCAN('doc=file':OPTIONS) > 0               
0098.00  /FREE                                                                    
0099.00     FD = open(%TRIMR(FILE): O_RDONLY + O_TEXTDATA + O_CCSID:0:CCS5035);   
0100.00     IF FD = FALSE#;                                                       
0101.00       MSG = ' ファイル ' + %TRIMR(FILE) + ' のオープンに失敗しました。 '; 
0102.00       RETURN FALSE#;                                                      
0103.00     ENDIF;                                                                
0104.00     lstat(%TRIM(FILE): STAT_);                                            
0105.00     TMPLEN   = STAT_.st_size + 100;                                       
0106.00     BYTE_RED = read (FD: %ADDR(TMPBUF): TMPLEN);                          
0107.00     CALLP close(FD);                                                      
0108.00  /END-FREE                                                                
0109.00 C                   MOVEA     TMPBUF        JSON                          
0110.00 C                   EVAL      LEN = BYTE_RED                              
0111.00 C                   ELSE                                                  
0112.00  /FREE                                                                    
0113.00    BYTE_RED = %LEN(FILE) + 1;                                             
0114.00  /END-FREE                                                                
0115.00 C                   EVAL      LEN  = %LEN(%TRIMR(FILE))                   
0116.00 C                   MOVEA     FILE          JSON                          
0117.00 C                   ENDIF                                                 
0118.00  /FREE                                                                    
0119.00    X = 0;                                                                 
0120.00    FOR N = 1 TO LEN;                                                              
0121.00      SELECT;                                                                      
0122.00      WHEN  JSON(N) = '{';                                                         
0123.00            IF bFILE   = *OFF;                                                     
0124.00              XML =  %TRIMR(XML) + '';                                       
0125.00              bFILE   = *ON;                                                       
0126.00            ENDIF;                                                                 
0127.00            IF bRECORD = *OFF;                                                     
0128.00              XML =  %TRIMR(XML) + '';                                     
0129.00              bRECORD = *ON;                                                       
0130.00            ENDIF;                                                                 
0131.00      WHEN  JSON(N) = '"';                                                         
0132.00            IF bOE  = *ON;                                                         
0133.00              VALUE = %TRIMR(VALUE) + JSON(N);  // 漢字中                          
0134.00              ITER;                                                                
0135.00            ENDIF;                                                                 
0136.00            IF bFLD = *OFF;                                                        
0137.00               IF %LEN(%TRIMR(FLD)) > 0;                      // フィールドの終わり
0138.00                  bFLD = *ON;                                                      
0139.00                  XML = %TRIMR(XML) + '<' + %TRIMR(FLD) + '>';                     
0140.00               ENDIF;                                                              
0141.00            ELSE;                                                                  
0142.00               IF bVALUE = *OFF;                                                   
0143.00                 IF %LEN(%TRIMR(VALUE)) > 0;                                       
0144.00                   bVALUE = *ON;                              // 値の終わ 
0145.00                   XML = %TRIMR(XML) + %TRIMR(VALUE) +                    
0146.00                         '';                        
0147.00                 ENDIF;                                                   
0148.00               ELSE;                                                      
0149.00               ENDIF;                                                     
0150.00            ENDIF;                                                        
0151.00      WHEN  JSON(N) = ':';                                                
0152.00            IF bOE  = *ON;                                                
0153.00              VALUE = %TRIMR(VALUE) + JSON(N);  // 漢字中                 
0154.00              ITER;                                                       
0155.00            ENDIF;                                                        
0156.00      WHEN  JSON(N) = ',';                                                
0157.00            IF bOE  = *ON;                                                
0158.00              VALUE = %TRIMR(VALUE) + JSON(N);  // 漢字中                 
0159.00              ITER;                                                       
0160.00            ENDIF;                                                        
0161.00            bFLD   = *OFF;                                                
0162.00            bVALUE = *OFF;                                                
0163.00            FLD    = ' ';                                                 
0164.00            VALUE = ' ';                                                  
0165.00      WHEN  JSON(N) = '}';                                                
0166.00            IF bOE = *OFF;                                                
0167.00              IF bRECORD = *ON;                                           
0168.00                XML = %TRIMR(XML) + '';                  
0169.00                bRECORD = *OFF;                                   
0170.00              ELSE;                                               
0171.00                XML = %TRIMR(XML) + '';                    
0172.00                bFILE   = *OFF;                                   
0173.00              ENDIF;                                              
0174.00              bFLD = *OFF;                                        
0175.00              bVALUE = *OFF;                                      
0176.00              FLD = ' ';                                          
0177.00              VALUE = ' ';                                        
0178.00            ELSE;                                                 
0179.00              VALUE = %TRIMR(VALUE) + JSON(N);  // 漢字中         
0180.00            ENDIF;                                                
0181.00      WHEN JSON(N) = CR;                                          
0182.00            IF bOE  = *ON;                                        
0183.00              VALUE = %TRIMR(VALUE) + JSON(N);  // 漢字中         
0184.00              ITER;                                               
0185.00            ENDIF;                                                
0186.00            IF JSON(N+1) = LF;                                    
0187.00              N = N + 1;                                          
0188.00            ENDIF;                                                
0189.00      OTHER;                                                      
0190.00            IF JSON(N) = OE;                                      
0191.00              bOE = *ON;                                          
0192.00            ELSE;                                                      
0193.00              IF JSON(N) = OF;                                         
0194.00                bOE = *OFF;                                            
0195.00              ENDIF;                                                   
0196.00            ENDIF;                                                     
0197.00            IF bFLD = *OFF;                                            
0198.00                FLD = %TRIMR(FLD) + JSON(N);                           
0199.00            ELSE;                                                      
0200.00              VALUE = %TRIMR(VALUE) + JSON(N);                         
0201.00            ENDIF;                                                     
0202.00      ENDSL;                                                           
0203.00    ENDFOR;                                                            
0204.00  /END-FREE                                                            
0205.00 C                   EVAL      XMLEN = %LEN(%TRIMR(XML))               
0206.00 C                   RETURN                  TRUE#                     
0207.00 P                 E                                                   
0208.00  *---( JSON2XML                  ここまで )----------------------*    


   

[コンパイル]

CRTBNDRPG OBJ(OBJLIB/TESTJSON2B) SRCFILE(MYSRCLIB/QRPGLESRC)
DFTACTRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)

[解説]

プロシージャー recHandler は

0024.00 D recHandler      PR            10I 0                                    
0025.00 D    OK                           N                                      
0026.00 D    REC                              LIKEDS(RECORD) DIM(1) CONST        
0027.00 D    numRecs                    10U 0 VALUE

として定義されており配列を1項目からなる配列として定義されているので
1回毎に呼び出されるように設計してある。

0052.00    XML-INTO %HANDLER(recHandler:ALLOK)                                                    
0053.00        %XML(%UCS2(XML): 'path=file/record ccsid=ucs2 case=any doc=string');

としてプロシージャー recHandler はXML-INTOから呼び出されるように指定されている。
これは一回だけの呼出しのように見えるのだが実際はXMLノレコードの数だけ
プロシージャーrecHandler は実行される。
従ってプロシージャーrecHandler は

0209.00  ****************************************************                 
0210.00  *       プロシージャーのプロトタイプ宣言           *                 
0211.00  ****************************************************                 
0212.00  *---( recHandler                ここから )-----------------------*   
0213.00 P recHandler      B                                                   
0214.00 D                 PI            10I 0                                 
0215.00 D    OK                           N                                   
0216.00 D    REC                              LIKEDS(RECORD) DIM(1) CONST  
0217.00 D    numRecs                    10U 0 VALUE                        
0218.00 C                   EVAL      RC = RC + 1                          
0219.00 C                   EVAL      RCR(RC) = REC(1)                     
0220.00 C                   RETURN                  TRUE#                  
0221.00 P                 E                                                
0222.00  *---( recHandler                ここまで )----------------------*

のようにして N回呼び出されて実行されることを想定した処理となっており

0218.00 C                   EVAL      RC = RC + 1                          
0219.00 C                   EVAL      RCR(RC) = REC(1)  

によってカウント・アップして処理されたデータ構造の内容が配列RCRに
保存されるようになっている。
このプロシージャーの処理によって
データ構造は

0047.00 D RCR             DS                  LIKEDS(RECORD) DIM(250)            
0048.00 D RC              S             10I 0 INZ(0)                                配列指標

に保管されるようになっている。
もちろん実際の処理では %DIM(RCR)( = 250)を超えないように制御することが
必要である。

今回でXML-INTOの解説は完結とする。
これによってユーザーでも JSON-INTO というプロシージャーを新規に開発することが
できることがおわかりであろう。
いつかは弊社のJSON-INTOプロシージャーをToolsで紹介するかもしれないが
来るJSONによるデータ交換のためにIBM iでの開発の助けになれば幸いである。
なおi5/OS Ver7.4でもまだ%JSON-INTOという組込み関数は存在していない。