opensourcecobol
JSON support
I tried to implement the JSON function. This function like a environment function with jansson.
DISPLAY JSON-NAME : Specify the name of JSON structure. DISPLAY JSON-KEY : Register period separated key names. ACCEPT JSON-VALUE: Gets the value specified by JSON-KEY from JSON-NAME data.
Look at this branch: feature/JSON_support
COBOL sample:
******************************************************************
* opensource COBOL JSON support
******************************************************************
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. JSON.
AUTHOR. n-isaka.
DATE-WRITTEN. 2019-06-13.
******************************************************************
ENVIRONMENT DIVISION.
******************************************************************
CONFIGURATION SECTION.
SPECIAL-NAMES.
******************************************************************
INPUT-OUTPUT SECTION.
FILE-CONTROL.
******************************************************************
DATA DIVISION.
******************************************************************
FILE SECTION.
******************************************************************
WORKING-STORAGE SECTION.
01 JSON-STR PIC X(255).
01 J-KEY PIC X(255).
01 J-VALUE PIC X(255).
******************************************************************
PROCEDURE DIVISION.
******************************************************************
MAIN-RTN.
* *** １つ目のJSONを登録
STRING '{' DELIMITED BY SIZE
'"key1" : "value1",' DELIMITED BY SIZE
'"key2" : 2,' DELIMITED BY SIZE
'"key3" : {' DELIMITED BY SIZE
'"key3-1" : "value3-1",' DELIMITED BY SIZE
'"key3-2" : "value3-2"' DELIMITED BY SIZE
'},' DELIMITED BY SIZE
'"key4" : [' DELIMITED BY SIZE
'"value4-1",' DELIMITED BY SIZE
'"value4-2",' DELIMITED BY SIZE
'"value4-3"' DELIMITED BY SIZE
']' DELIMITED BY SIZE
'}' DELIMITED BY SIZE
INTO JSON-STR.
DISPLAY "JSON" UPON JSON-NAME.
DISPLAY JSON-STR UPON JSON-VALUE.
* *** ２つ目のJSONを登録
MOVE SPACE TO JSON-STR.
STRING '{' DELIMITED BY SIZE
'"key10" : "value10"' DELIMITED BY SIZE
'}' DELIMITED BY SIZE
INTO JSON-STR.
DISPLAY "JSON2" UPON JSON-NAME.
DISPLAY JSON-STR UPON JSON-VALUE.
* *** １つ目のJSONを選択
DISPLAY "JSON" UPON JSON-NAME.
* *** １つ目のJSONからKEYでデータを取得
* *** 配列は対応
MOVE "key4[1]" TO J-KEY.
MOVE SPACE TO J-VALUE.
DISPLAY J-KEY UPON JSON-KEY.
ACCEPT J-VALUE FROM JSON-VALUE.
DISPLAY J-KEY ":" J-VALUE.
* key4[1] : value4-2
* *** 数値型も対応
MOVE "key2" TO J-KEY.
MOVE SPACE TO J-VALUE.
DISPLAY J-KEY UPON JSON-KEY.
ACCEPT J-VALUE FROM JSON-VALUE.
DISPLAY J-KEY ":" J-VALUE.
* key2 : 2
* *** 入れ子も対応
MOVE "key3.key3-2" TO J-KEY.
MOVE SPACE TO J-VALUE.
DISPLAY J-KEY UPON JSON-KEY.
ACCEPT J-VALUE FROM JSON-VALUE.
DISPLAY J-KEY ":" J-VALUE.
* key3.key3-2 : value3-2
* *** ２つ目のJSONを選択
DISPLAY "JSON2" UPON JSON-NAME.
* *** ２つ目のJSONから値を取得
MOVE "key10" TO J-KEY.
MOVE SPACE TO J-VALUE.
DISPLAY J-KEY UPON JSON-KEY.
ACCEPT J-VALUE FROM JSON-VALUE.
DISPLAY J-KEY ":" J-VALUE.
* key10 : value10
* *** この時1個目のJSONからは値がとれない
MOVE "key3.key3-2" TO J-KEY.
MOVE SPACE TO J-VALUE.
DISPLAY J-KEY UPON JSON-KEY.
ACCEPT J-VALUE FROM JSON-VALUE.
DISPLAY J-KEY ":" J-VALUE.
* key3.key3-2 :
MAIN-EXT.
STOP RUN.
I highly suggest to not implement it that way and add the IBM extension GENERATE JSON instead. See patch for adding GENERATE JSON to GnuCOBOL.
If this project would update to the newer (L)GPL versions then it could integrate any changes that were proposed and/or integrated into GnuCOBOL under (C) Free Software Foundation (the old OpenCOBOL Copyrights were transferred to the FSF under the updated license).
Thank you for the suggestion. I will look at it.
We will discuss licensing within the team.
I understood that IBM extensions are intuitive operations that correspond to COBOL data types.
However, I think that I may be able to use my approach to process JSON irregular data format.
I would like to think a little more.
In addition, we are discussing about license.
I understood that IBM extensions are intuitive operations that correspond to COBOL data types.
Especially: it is a "common" extension (adopted by at least MicroFocus and likely also others) you may find in existing sources.
However, I think that I may be able to use my approach to process JSON irregular data format.
Please elaborate on this.
In addition, we are discussing about license.
I totally agree that this is off-topic for this issue, it may be tracked with a different one.
I understand IBM extensions are used as follows:
WORKING-STORAGE SECTION.
01 EMP-REC-VARS.
03 EMP-NO PIC S9(04) VALUE ZERO.
03 EMP-NAME PIC X(20) .
03 EMP-SALARY PIC S9(04) VALUE ZERO.
{
"EMP-REC-VARS" : {
"EMP-NO" : 0001,
"EMP-NAME" : "HOKKAI TARO ",
"EMP-SALARY" : 0400
}
}
IBM extensions insert such JSON data into COBOL data type.
But, JSON data is flexible, they have not a data or additional data.
{
"EMP-REC-VARS" : {
"EMP-NO" : 0001,
"EMP-NAME" : "HOKKAI TARO ",
"EMP-AGE" : 32
}
}
In such cases, the IBM extension will be "ON EXCEPTION".
I think I can use that JSON data, because my function can be given a KEY dynamically. So, I want to implement functions for example "GET_KEYS", "GET_ARRAYS_SIZE".
I just updated the branch, feature/JSON_support.
Each function is called by CALL, COBOL Programs hold a JSON object in POINTER type.
I think that new functions is more usefull for using flexible JSON data. Because, Users can reach any object by using functions also GET_KEY, GET_ARRLEN, GET_TYPE.
COBOL sample:
******************************************************************
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. JSON7.
AUTHOR. n-isaka.
DATE-WRITTEN. 2019-07-11.
******************************************************************
ENVIRONMENT DIVISION.
******************************************************************
CONFIGURATION SECTION.
SPECIAL-NAMES.
******************************************************************
INPUT-OUTPUT SECTION.
FILE-CONTROL.
******************************************************************
DATA DIVISION.
******************************************************************
FILE SECTION.
******************************************************************
WORKING-STORAGE SECTION.
01 JSON-STR PIC X(255).
01 J-KEY PIC X(30).
01 J-VALUE PIC X(30).
01 J-VALUE-INT PIC 9(05).
*MAIN
01 STATUS1 PIC 9(8) COMP-5.
01 STATUS2 PIC 9(8) COMP-5.
01 J-KEY-NUM PIC 9(2).
01 JSON-ROOT USAGE POINTER.
01 J-POINTER USAGE POINTER.
01 I-POINTER USAGE POINTER.
*SUB
01 STATUS3 PIC 9(8) COMP-5.
01 STATUS4 PIC 9(8) COMP-5.
01 J-KEY-NUM2 PIC 9(2).
01 J-LENGTH PIC 9(2).
01 J-POINTER2 USAGE POINTER.
01 I-POINTER2 USAGE POINTER.
******************************************************************
LINKAGE SECTION.
******************************************************************
PROCEDURE DIVISION.
******************************************************************
MAIN-RTN.
STRING '{' DELIMITED BY SIZE
'"key1" : "value1",' DELIMITED BY SIZE
'"key2" : 2,' DELIMITED BY SIZE
'"key3" : {' DELIMITED BY SIZE
'"key3-1" : "value3-1",' DELIMITED BY SIZE
'"key3-2" : "value3-2"' DELIMITED BY SIZE
'},' DELIMITED BY SIZE
'"key4" : [' DELIMITED BY SIZE
'"value4-1",' DELIMITED BY SIZE
'"value4-2",' DELIMITED BY SIZE
'"value4-3"' DELIMITED BY SIZE
']' DELIMITED BY SIZE
'}' DELIMITED BY SIZE
INTO JSON-STR.
CALL "CBL_JSON_PARSE" USING JSON-STR,
JSON-ROOT
GIVING STATUS1.
CALL "CBL_JSON_GET_KEY_START" USING JSON-ROOT,
I-POINTER
GIVING STATUS1.
MOVE 0 TO STATUS1.
MOVE 1 TO J-KEY-NUM.
PERFORM UNTIL J-KEY-NUM >= 99
CALL "CBL_JSON_GET_KEY_NEXT"
USING JSON-ROOT,
I-POINTER,
J-KEY
GIVING STATUS1
IF STATUS1 = 10 THEN
EXIT PERFORM
END-IF
DISPLAY J-KEY
CALL "CBL_JSON_GET_OBJECT" USING JSON-ROOT,
J-KEY,
J-POINTER
GIVING STATUS2
CALL "CBL_JSON_GET_TYPE" USING J-POINTER
GIVING STATUS2
EVALUATE STATUS2
WHEN 0
PERFORM JSON-OBJECT
WHEN 1
PERFORM JSON-ARRAY
WHEN 2
CALL "CBL_JSON_GET_VALUE" USING J-POINTER,
J-VALUE
GIVING STATUS2
DISPLAY "STRING:" J-VALUE
WHEN 3
CALL "CBL_JSON_GET_VALUE" USING J-POINTER,
J-VALUE-INT
GIVING STATUS2
DISPLAY "INTEGER:" J-VALUE-INT
END-EVALUATE
ADD 1 TO J-KEY-NUM
END-PERFORM.
MAIN-EXT.
STOP RUN.
JSON-OBJECT SECTION.
CALL "CBL_JSON_GET_KEY_START" USING J-POINTER,
I-POINTER2
GIVING STATUS3.
MOVE 0 TO STATUS3.
MOVE 1 TO J-KEY-NUM.
PERFORM UNTIL J-KEY-NUM2 >= 99
CALL "CBL_JSON_GET_KEY_NEXT"
USING J-POINTER,
I-POINTER2,
J-KEY
GIVING STATUS3
IF STATUS3 = 10 THEN
EXIT PERFORM
END-IF
DISPLAY J-KEY
CALL "CBL_JSON_GET_OBJECT" USING J-POINTER,
J-KEY,
J-POINTER2
GIVING STATUS4
CALL "CBL_JSON_GET_VALUE" USING J-POINTER2,
J-VALUE
GIVING STATUS4
DISPLAY "CHILD:" J-VALUE
ADD 1 TO J-KEY-NUM2
END-PERFORM.
JSON-OBJECT-EXT.
EXIT SECTION.
JSON-ARRAY SECTION.
CALL "CBL_JSON_GET_ARRLEN" USING J-POINTER
GIVING J-LENGTH.
MOVE 0 TO STATUS3.
DISPLAY "LENGTH:" J-LENGTH.
PERFORM VARYING J-KEY-NUM FROM 0 BY 1
UNTIL J-KEY-NUM >= J-LENGTH
CALL "CBL_JSON_GET_OBJECT_A" USING J-POINTER,
J-KEY-NUM,
J-POINTER2
GIVING STATUS4
CALL "CBL_JSON_GET_VALUE" USING J-POINTER2,
J-VALUE
GIVING STATUS4
DISPLAY "INDEX[" J-KEY-NUM "]:" J-VALUE
END-PERFORM.
JSON-ARRAY-EXT.
EXIT SECTION.
In such cases, the IBM extension will be "ON EXCEPTION".
Looking at https://www.microfocus.com/documentation/visual-cobol/vc60/DevHub/GUID-BC279EEA-6FE7-4F79-AB8B-062A709E4B34.html it wouldn't.
It would populate every matching item, would leave items with no name matching as-is (=COBOL name, but no JSON match) and for items that are only in JSON that have no match in COBOL would set JSON-RETURN to a nonzero value. Exceptions will only occur if there is no match at all or if the datatypes don't match.
The biggest point to consider the IBM extension: it is already wide adapted, so will ease porting scenarios (and also has a good chance to be added to COBOL 20xx+ [the next standard after the current round]).