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 '' + %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) + ' ';
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という組込み関数は存在していない。
