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) + ' '; 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 ここまで )----------------------*'; 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 '' + %TRIMR(FLD) + '>'; 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) + '
[コンパイル]
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という組込み関数は存在していない。