いよいよJSONの解析も本番に入ってきて今度はIFSストリームとして
登録されているJSONをオープンしてそれをXML-INTOで
解析することを試みることしよう。

まずIFSのJSONの全容を紹介する。
[ JSON: /AS400-NET.USR/TEMP/TEST.JSN ]
{
{
"SHCODE": "NV-BS30S",
"SHNAME": " 目次ビデオ ",
"SHTANK": "165000",
"SHSCOD": "0002"
}
{
"SHCODE": "NV-BS50S",
"SHNAME": " ビデオ画王 ",
"SHTANK": "200000",
"SHSCOD": "0002"
}
{
"SHCODE": "NV-CF1",
"SHNAME": " Cカセット編集ビデオ ",
"SHTANK": "58000",
"SHSCOD": "0002"
"SHSCOD": "0002"
}
{
"SHCODE": "NV-CF2",
"SHNAME": " 薄型テレビ ",
"SHTANK": "98000",
"SHSCOD": "0003"
}
{
"SHCODE": "NV-CF81",
"SHNAME": " 更新テスト ",
"SHTANK": "58000",
"SHSCOD": "0004"
}
{
"SHCODE": "NV-CF9",
"SHNAME": " 漢字テスト ",
"SHTANK": "19000",
"SHSCOD": "0002"
"SHSCOD": "0002"
}
}
これを読んでXML-INTOで処理するRPGソースを以下に示す。
[ JSON パーサーのテスト : TESTJSON2 ]
ソースはこちらから
0001.00 H DFTNAME(TESTJSON2) DATEDIT(*YMD/) BNDDIR('QC2LE')
0002.00 H CCSID(*GRAPH:*SRC)
0003.00 F********** JSON パーサーのテスト 2 ***********************************
0004.00 F*
0005.00 F**********************************************************************
0006.00
0007.00 * CRTBNDRPG OBJ(OBJLIB/TESTJSON2) SRCFILE(MYSRCLIB/QRPGLESRC)
0008.00 * DFTACTRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
0009.00
0010.00 *-------------------------------------------------------------------*
0011.00 * 2021/12/01 : 作成
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 *( 作業変数 )
0025.00 D XMLIFS S 128A INZ('/AS400-NET.USR/TEMP/TEST.JSN')
0026.00 D STAT_ DS LIKEDS(stat_t)
0027.00 D TRUE# S 10I 0 INZ(0)
0028.00 D FALSE# S 10I 0 INZ(-1)
0029.00 D JSON S 512A
0030.00 D XML S 32763A
0031.00 D UCS2 S 32763C CCSID(1200)
0032.00 D MSG S 80A
0033.00 D XMLEN S 10I 0
0034.00
0035.00 D RECORD DS QUALIFIED DIM(30)
0036.00 D SHCODE 1 10A
0037.00 D SHNAME 11 34A
0038.00 D SHTANK 35 41S 0
0039.00 D SHSCOD 42 45A
0040.00
0041.00 /FREE
0042.00 JSON2XML(%ADDR(XMLIFS): %ADDR(XML): %ADDR(XMLEN): 'doc=file'); //JSON を XML に変換する
0043.00 XML-INTO RECORD
0044.00 %XML(%UCS2(XML): 'path=file/record ccsid=ucs2 case=any doc=string');
0045.00 /END-FREE
0046.00 C SETON LR
0047.00 C RETURN
0048.00 ************************************************************
0049.00 * JSON2XML : JSON を XML に変換する
0050.00 ************************************************************
0051.00 *---( JSON2XML ここから )-----------------------*
0052.00 * JSON を XML に変換する
0053.00 P JSON2XML B
0054.00 D PI 10I 0
0055.00 D FILE_P * Value
0056.00 D XML_P * Value
0057.00 D XMLEN_P * Value
0058.00 D OPTIONS 128A Value
0059.00 *
0060.00 *( 作業変数 )
0061.00 D FILE S 128A BASED(FILE_P)
0062.00 D XML S 32763A BASED(XML_P)
0063.00 D XMLEN S 10I 0 BASED(XMLEN_P)
0064.00 D FD S 10I 0
0065.00 D JSON S 1A DIM(32763)
0066.00 D OPTION S 128A BASED(OPTION_P)
0067.00 D N S 10I 0
0068.00 D LEN S 10I 0
0069.00 D X S 4S 0
0070.00 D FLD S 10A
0071.00 D VALUE S 256A
0072.00 D bFLD S N INZ(*OFF)
0073.00 D bVALUE S N INZ(*OFF)
0074.00 D bOE S N INZ(*OFF)
0075.00 D bRECORD S N INZ(*OFF)
0076.00 D bFILE S N INZ(*OFF)
0077.00 D OE S 1A INZ(X'0E')
0078.00 D OF S 1A INZ(X'0F')
0079.00 D CR S 1A INZ(X'0D')
0080.00 D LF S 1A INZ(X'25')
0081.00 D TMPBUF S 32763A
0082.00 D TMPLEN S 10I 0
0083.00 D BYTE_RED S 10I 0
0084.00 D CCS5035 S 10I 0 INZ(5035)
0085.00 D CCS1200 S 10I 0 INZ(1200)
0086.00 D STAT DS LIKEDS(stat_t)
0087.00
0088.00 C IF %SCAN('doc=file':OPTIONS) > 0
0089.00 /FREE
0090.00 FD = open(%TRIMR(FILE): O_RDONLY + O_TEXTDATA + O_CCSID:0:CCS5035);
0091.00 IF FD = FALSE#;
0092.00 MSG = ' ファイル ' + %TRIMR(FILE) + ' のオープンに失敗しました。 ';
0093.00 RETURN FALSE#;
0094.00 ENDIF;
0095.00 lstat(%TRIM(FILE): STAT_);
0096.00 TMPLEN = STAT_.st_size + 100;
0097.00 BYTE_RED = read (FD: %ADDR(TMPBUF): TMPLEN);
0098.00 CALLP close(FD);
0099.00 /END-FREE
0100.00 C MOVEA TMPBUF JSON
0101.00 C EVAL LEN = BYTE_RED
0102.00 C ELSE
0103.00 /FREE
0104.00 BYTE_RED = %LEN(FILE) + 1;
0105.00 /END-FREE
0106.00 C EVAL LEN = %LEN(%TRIMR(FILE))
0107.00 C MOVEA FILE JSON
0108.00 C ENDIF
0109.00 /FREE
0110.00 X = 0;
0111.00 FOR N = 1 TO LEN;
0112.00 SELECT;
0113.00 WHEN JSON(N) = '{';
0114.00 IF bFILE = *OFF;
0115.00 XML = %TRIMR(XML) + '';
0116.00 bFILE = *ON;
0117.00 ENDIF;
0118.00 IF bRECORD = *OFF;
0119.00 XML = %TRIMR(XML) + '';
0120.00 bRECORD = *ON;
0121.00 ENDIF;
0122.00 WHEN JSON(N) = '"';
0123.00 IF bOE = *ON;
0124.00 VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中
0125.00 ITER;
0126.00 ENDIF;
0127.00 IF bFLD = *OFF;
0128.00 IF %LEN(%TRIMR(FLD)) > 0; // フィールドの終わり
0129.00 bFLD = *ON;
0130.00 XML = %TRIMR(XML) + '<' + %TRIMR(FLD) + '>';
0131.00 ENDIF;
0132.00 ELSE;
0133.00 IF bVALUE = *OFF;
0134.00 IF %LEN(%TRIMR(VALUE)) > 0;
0135.00 bVALUE = *ON; // 値の終わり
0136.00 XML = %TRIMR(XML) + %TRIMR(VALUE) +
0137.00 '' + %TRIMR(FLD) + '>';
0138.00 ENDIF;
0139.00 ELSE;
0140.00 ENDIF;
0141.00 ENDIF;
0142.00 WHEN JSON(N) = ':';
0143.00 IF bOE = *ON;
0144.00 VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中
0145.00 ITER;
0146.00 ENDIF;
0147.00 WHEN JSON(N) = ',';
0148.00 IF bOE = *ON;
0149.00 VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中
0150.00 ITER;
0151.00 ENDIF;
0152.00 bFLD = *OFF;
0153.00 bVALUE = *OFF;
0154.00 FLD = ' ';
0155.00 VALUE = ' ';
0156.00 WHEN JSON(N) = '}';
0157.00 IF bOE = *OFF;
0158.00 IF bRECORD = *ON;
0159.00 XML = %TRIMR(XML) + ' ';
0160.00 bRECORD = *OFF;
0161.00 ELSE;
0162.00 XML = %TRIMR(XML) + ' ';
0163.00 bFILE = *OFF;
0164.00 ENDIF;
0165.00 bFLD = *OFF;
0166.00 bVALUE = *OFF;
0167.00 FLD = ' ';
0168.00 VALUE = ' ';
0169.00 ELSE;
0170.00 VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中
0171.00 ENDIF;
0172.00 WHEN JSON(N) = CR;
0173.00 IF bOE = *ON;
0174.00 VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中
0175.00 ITER;
0176.00 ENDIF;
0177.00 IF JSON(N+1) = LF;
0178.00 N = N + 1;
0179.00 ENDIF;
0180.00 OTHER;
0181.00 IF JSON(N) = OE;
0182.00 bOE = *ON;
0183.00 ELSE;
0184.00 IF JSON(N) = OF;
0185.00 bOE = *OFF;
0186.00 ENDIF;
0187.00 ENDIF;
0188.00 IF bFLD = *OFF;
0189.00 FLD = %TRIMR(FLD) + JSON(N);
0190.00 ELSE;
0191.00 VALUE = %TRIMR(VALUE) + JSON(N);
0192.00 ENDIF;
0193.00 ENDSL;
0194.00 ENDFOR;
0195.00 /END-FREE
0196.00 C EVAL XMLEN = %LEN(%TRIMR(XML))
0197.00 C RETURN TRUE#
0198.00 P E
0199.00 *---( JSON2XML ここまで )----------------------*
[コンパイル]
CRTBNDRPG OBJ(OBJLIB/TESTJSON2) SRCFILE(MYSRCLIB/QRPGLESRC)
DFTACTRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
[解説]
JSONのIFSストリーム・ファイルは
0025.00 D XMLIFS S 128A INZ('/AS400-NET.USR/TEMP/TEST.JSN')
に定義されていてこれを
0042.00 JSON2XML(%ADDR(XMLIFS): %ADDR(XML): %ADDR(XMLEN): 'doc=file'); //JSON を XML に変換する
でXMLに変換している。
前回、紹介した JSON2XML の機能は少し拡張されていて
・漢字中に見つかった制御コード( { } など)を漢字の一部を誤解しないように対策している。
・XMLの最初と最後を <FILE> …..</FILE> で閉じている。
さてXML-INTOは
0043.00 XML-INTO RECORD 0044.00 %XML(%UCS2(XML): 'path=file/record ccsid=ucs2 case=any doc=string');
のようにして (%UCS2(XML) で一度にUCS-2(=UTF-16)に変換しており
path=file/record を宣言している。
また %UCS2(XML)で Unicodeデータは文字列として読んでいるので doc=string を宣言している。
もちろん英大文字も許容するように case=any も宣言している。
これでJSONデータ・ファイルもでーた構造(DS): RECORD に変換することができる。
デバッグ・モードで見ると
評価式
前のデバッグ式
> EVAL record
RECORD.SHCODE(1) = 'NV-BS30S '
RECORD.SHNAME(1) = ' 目次ビ デオ '
RECORD.SHTANK(1) = 0165000.
RECORD.SHSCOD(1) = '0002'
RECORD.SHCODE(2) = 'NV-BS50S '
RECORD.SHNAME(2) = ' ビデオ画王 '
RECORD.SHTANK(2) = 0200000.
RECORD.SHSCOD(2) = '0002'
RECORD.SHCODE(3) = 'NV-CF1 '
RECORD.SHNAME(3) = ' Cカセット編集ビデオ '
RECORD.SHTANK(3) = 0058000.
RECORD.SHSCOD(3) = '0002'
RECORD.SHCODE(4) = 'NV-CF2 '
RECORD.SHNAME(4) = ' 薄型テレビ
RECORD.SHTANK(4) = 0098000.
RECORD.SHSCOD(4) = '0003'
RECORD.SHCODE(5) = 'NV-CF81 '
RECORD.SHNAME(5) = ' 更新テスト
RECORD.SHTANK(5) = 0058000.
RECORD.SHSCOD(5) = '0004'
RECORD.SHCODE(6) = 'NV-CF9 '
RECORD.SHNAME(6) = ' 漢字テスト
RECORD.SHTANK(6) = 0019000.
RECORD.SHSCOD(6) = '0002'
と表示される。
ところでデータ構造(DS): RECORD は
0035.00 D RECORD DS QUALIFIED DIM(30) 0036.00 D SHCODE 1 10A 0037.00 D SHNAME 11 34A 0038.00 D SHTANK 35 41S 0 0039.00 D SHSCOD 42 45A 0040.00
と定義されているのだが DIM(30)というのは適当な値でしかない
このあたりを動的に処理する方法として次回は %HANDLER の使い方を
紹介する。
