json 42777 241 0 0 11707061215 7163 5 ustar 00IUSR0001 json/unittest 42777 241 0 0 11711472175 11050 5 ustar 00IUSR0001 json/unittest/json_ut_04.rpgle 100777 241 0 10642 11712047615 14265 0 ustar 00IUSR0001 /** * \brief JSON Unit Test : Test duplicate entries (keys) * * Putting a value with the same key in a JSON object should replace the * existing value with the new one. * * \author Mihael Schmidt * \date 30.01.2012 */ H nomain *------------------------------------------------------------------------- * Prototypes *------------------------------------------------------------------------- D test_duplicateKeyString... D PR D test_duplicateKeyBoolean... D PR D test_duplicateKeyInteger... D PR D test_duplicateKeyDouble... D PR D test_duplicateKeyDate... D PR D test_duplicateKeyDecimal... D PR /copy RPGUNIT1,TESTCASE /copy 'json/json_h.rpgle' /copy 'message_h.rpgle' P test_duplicateKeysString... P B export * D json S * /free json = json_create(); json_putString(json : 'string' : 'Michael'); iEqual(json_size(json) : 1); aEqual(%str(json_getString(json : 'string')) : 'Michael'); json_putString(json : 'string' : 'Mihael'); iEqual(json_size(json) : 1); aEqual(%str(json_getString(json : 'string')) : 'Mihael'); json_dispose(json); /end-free P E P test_duplicateKeysBoolean... P B export * D json S * /free json = json_create(); json_putBoolean(json : 'bool' : *on); iEqual(json_size(json) : 1); assert(json_getBoolean(json : 'bool') = *on : 'Wrong value for added boolean value.'); json_putBoolean(json : 'bool' : *off); iEqual(json_size(json) : 1); assert(json_getBoolean(json : 'bool') = *off : 'Wrong value for added boolean value.'); json_dispose(json); /end-free P E P test_duplicateKeysInteger... P B export * D json S * /free json = json_create(); json_putInt(json : 'int' : 111); iEqual(111 : json_getInt(json : 'int')); json_putInt(json : 'int' : 222); iEqual(222 : json_getInt(json : 'int')); json_dispose(json); /end-free P E P test_duplicateKeysDouble... P B export * D json S * /free json = json_create(); json_putDouble(json : 'double' : 1.11); assert(json_getDouble(json : 'double') < 2 : 'Wrong value added for double type.'); json_putDouble(json : 'double' : 22.2); assert(json_getDouble(json : 'double') > 22.0 : 'Wrong value added for double type.'); json_dispose(json); /end-free P E P test_duplicateKeysDate... P B export * D json S * D testDate S D D testDate2 S D /free testDate = %date(); testDate2 = %date() + %days(1); json = json_create(); json_util_putDate(json : 'date' : testDate); assert(testDate = json_util_getDate(json : 'date') : 'Wrong value added for date type.'); json_util_putDate(json : 'date' : testDate2); assert(testDate2 = json_util_getDate(json : 'date') : 'Wrong value added for date type.'); json_dispose(json); /end-free P E P test_duplicateKeysDecimal... P B export * D json S * /free json = json_create(); json_util_putDecimal(json : 'decimal' : 1.23); json_util_putDecimal(json : 'decimal' : 12.34); assert(12.34 = json_util_getDecimal(json : 'decimal') : 'Wrong value added for date type.'); json_dispose(json); /end-free P E json/unittest/json_par_1.rpgle 100777 241 0 25554 11707333746 14353 0 ustar 00IUSR0001 /** * \brief JSON Parser : Unit Tests * * \author Mihael Schmidt * \date 21.01.2011 */ H nomain *------------------------------------------------------------------------- * Prototypes *------------------------------------------------------------------------- D test_emptyObject... D PR D test_simpleObject... D PR D test_alternativeSyntax... D PR D test_nestedObject... D PR D test_simpleArray... D PR D test_nestedArray... D PR D test_emptyArrayWithoutObject... D PR D test_onlyArrays... D PR D test_arrayAndObject... D PR D test_unicodeCharacters... D PR /copy RPGUNIT1,TESTCASE /copy 'json/json_h.rpgle' /copy 'message_h.rpgle' *------------------------------------------------------------------------- * Procedures *------------------------------------------------------------------------- P test_emptyObject... P B export * D json S * /free json = json_util_fromFile('test1.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); iEqual(0 : json_size(json)); json_dispose(json); /end-free P E P test_simpleObject... P B export * D json S * /free json = json_util_fromFile('test2.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); iEqual(1 : json_size(json)); aEqual('value' : %str(json_getString(json : 'key'))); json_dispose(json); /end-free P E P test_alternativeSyntax... P B export * D json S * /free json = json_util_fromFile('test3.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); iEqual(7 : json_size(json)); aEqual('value1' : %str(json_getString(json : 'key1'))); aEqual('value2' : %str(json_getString(json : 'key2'))); aEqual('value3' : %str(json_getString(json : 'key3'))); aEqual('value4' : %str(json_getString(json : 'key4'))); assert(*on = json_getBoolean(json : 'special1') : 'Entry with key ' + 'special1 should be true/*on.'); assert(*off = json_getBoolean(json : 'special2') : 'Entry with key ' + 'special2 should be false/*off.'); assert(json_isNull(json : 'special3') : 'Entry with key ' + 'special3 should be null.'); json_dispose(json); /end-free P E P test_nestedObject... P B export * D json S * D nestedObject S * /free json = json_util_fromFile('test4.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); nestedObject = json_getObject(json : 'nested object'); assert(nestedObject <> *null : 'One level nested json object mustn''t be null.'); assert(json_contains(nestedObject : 'subsubobject') : 'Nested object should contain further nested json object ' + 'subsubobject.'); nestedObject = json_getObject(nestedObject : 'subsubobject'); assert(nestedObject <> *null : '2nd level nested json object mustn''t be null.'); nestedObject = json_getObject(nestedObject : 'value'); assert(nestedObject <> *null : '3rd level nested json object mustn''t be null.'); assert(json_isEmpty(nestedObject) : '3rd level nested object should ' + 'be empty.'); json_dispose(json); /end-free P E P test_simpleArray... P B export * D json S * D array S * /free json = json_util_fromFile('test5.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); assert(json_contains(json : 'product line ids') : 'JSON object should contain entry with key "product line ids".'); array = json_getArray(json : 'product line ids'); assert(array <> *null : 'JSON array should not be *null.'); iEqual(4 : jsona_size(array)); aEqual('200.1.1' : %str(jsona_getString(array : 0))); aEqual('200.1.2.1' : %str(jsona_getString(array : 1))); aEqual('200.10.10.1' : %str(jsona_getString(array : 2))); aEqual('200.11.11.1' : %str(jsona_getString(array : 3))); json_dispose(json); /end-free P E P test_nestedArray... P B export * D json S * D array S * D nestedArray S * /free json = json_util_fromFile('test6.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); assert(json_contains(json : 'product line ids') : 'JSON object should contain entry with key "product line ids".'); array = json_getArray(json : 'product line ids'); assert(array <> *null : 'JSON array should not be *null.'); iEqual(4 : jsona_size(array)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 0)); nestedArray = jsona_getArray(array : 0); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(3 : jsona_size(nestedArray)); iEqual(200 : jsona_getInt(nestedArray : 0)); iEqual(1 : jsona_getInt(nestedArray : 1)); iEqual(1 : jsona_getInt(nestedArray : 2)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 1)); nestedArray = jsona_getArray(array : 1); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(4 : jsona_size(nestedArray)); iEqual(200 : jsona_getInt(nestedArray : 0)); iEqual(10 : jsona_getInt(nestedArray : 1)); iEqual(10 : jsona_getInt(nestedArray : 2)); iEqual(1 : jsona_getInt(nestedArray : 3)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 2)); nestedArray = jsona_getArray(array : 2); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(4 : jsona_size(nestedArray)); iEqual(200 : jsona_getInt(nestedArray : 0)); iEqual(11 : jsona_getInt(nestedArray : 1)); iEqual(11 : jsona_getInt(nestedArray : 2)); iEqual(1 : jsona_getInt(nestedArray : 3)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 3)); nestedArray = jsona_getArray(array : 3); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(0 : jsona_size(nestedArray)); json_dispose(json); /end-free P E P test_emptyArrayWithoutObject... P B export * D array S * /free array = json_util_fromFile('test7.json' + x'00'); assert(array <> *null : 'Parsed json array mustn''t be null.'); iEqual(0 : jsona_size(array)); jsona_dispose(array); /end-free P E P test_onlyArrays... P B export * D array S * D nestedArray S * /free array = json_util_fromFile('test8.json' + x'00'); assert(array <> *null : 'Parsed json array mustn''t be null.'); iEqual(4 : jsona_size(array)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 0)); nestedArray = jsona_getArray(array : 0); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(3 : jsona_size(nestedArray)); iEqual(200 : jsona_getInt(nestedArray : 0)); iEqual(1 : jsona_getInt(nestedArray : 1)); iEqual(1 : jsona_getInt(nestedArray : 2)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 1)); nestedArray = jsona_getArray(array : 1); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(4 : jsona_size(nestedArray)); iEqual(200 : jsona_getInt(nestedArray : 0)); iEqual(10 : jsona_getInt(nestedArray : 1)); iEqual(10 : jsona_getInt(nestedArray : 2)); iEqual(1 : jsona_getInt(nestedArray : 3)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 2)); nestedArray = jsona_getArray(array : 2); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(4 : jsona_size(nestedArray)); iEqual(200 : jsona_getInt(nestedArray : 0)); iEqual(11 : jsona_getInt(nestedArray : 1)); iEqual(11 : jsona_getInt(nestedArray : 2)); iEqual(1 : jsona_getInt(nestedArray : 3)); iEqual(JSON_TYPE_ARRAY : jsona_getEntryType(array : 3)); nestedArray = jsona_getArray(array : 3); assert(nestedArray <> *null : 'Nested JSON array should not be *null.'); iEqual(0 : jsona_size(nestedArray)); jsona_dispose(array); /end-free P E P test_arrayAndObject... P B export D array S * D object S * /free array = json_util_fromFile('test9.json' + x'00'); assert(array <> *null : 'Parsed json array mustn''t be null.'); iEqual(1 : jsona_size(array)); iEqual(JSON_TYPE_OBJECT : jsona_getEntryType(array : 0)); object = jsona_getObject(array : 0); iEqual(1 : json_size(object)); iEqual(358 : json_getInt(object : 'id')); jsona_dispose(array); /end-free P E P test_unicodeCharacters... P B export * D json S * D umlaute_raw S 3A /free umlaute_raw = u'00E400F600FC'; // äüu json = json_util_fromFile('test10.json' + x'00'); assert(json <> *null : 'Parsed json object mustn''t be null.'); iEqual(3 : json_size(json)); aEqual(umlaute_raw : %str(json_get(json : 'umlaute_raw'))); json_dispose(json); /end-free P E json/unittest/json_ut_01.rpgle 100777 241 0 3643 12004324336 14236 0 ustar 00IUSR0001 /** * \brief JSON : Unit Test * * \author Mihael Schmidt * \date 21.01.2011 */ H nomain *------------------------------------------------------------------------- * Prototypes *------------------------------------------------------------------------- D test_basics... D PR D test_typed_values... D PR /copy RPGUNIT1,TESTCASE /copy 'json/json_h.rpgle' /copy 'message_h.rpgle' P test_basics... P B export * D json S * /free json = json_create(); assert(json <> *null : 'Newly created json object mustn''t be null.'); json_putBoolean(json : 'bool' : *on); iEqual(json_size(json) : 1); assert(json_getBoolean(json : 'bool') = *on : 'Wrong value for added boolean value.'); json_remove(json : 'bool'); iEqual(json_size(json) : 0); assert(json_isEmpty(json) : 'JSON object should be empty.'); json_putInt(json : 'Integer' : 358); iEqual(json_getInt(json : 'Integer') : 358); json_putString(json : 'String' : 'Mihael'); aEqual(%str(json_getString(json : 'String')) : 'Mihael'); json_dispose(json); /end-free P E P test_typed_values... P B export * D json S * * /free json = json_create(); json_putString(json : 'surname' : 'Mihael'); json_putString(json : 'nickname' : 'Mihael' : 4); iEqual(2 : json_size(json)); aEqual('Mihael' : %str(json_getString(json : 'surname'))); aEqual('Miha' : %str(json_getString(json : 'nickname'))); json_dispose(json); /end-free P E json/unittest/json_ut_02.rpgle 100666 241 0 15457 12004321105 14251 0 ustar 00IUSR0001 /** * \brief JSON Array : Unit Test * * \author Mihael Schmidt * \date 01.07.2011 * * \todo test case for jsona_toString() */ H nomain *------------------------------------------------------------------------- * Prototypes *------------------------------------------------------------------------- D test_basics... D PR D test_empty... D PR D test_addTypedValues... D PR D test_addTypedValuesPositioned... D PR /copy RPGUNIT1,TESTCASE /copy 'json/json_h.rpgle' /copy 'message_h.rpgle' *------------------------------------------------------------------------- * Procedures *------------------------------------------------------------------------- P test_basics... P B export * D json S * D jsona S * /free json = json_create(); jsona = jsona_create(); json_putArray(json : 'array' : jsona); assert(json <> *null : 'Newly created json object mustn''t be null.'); assert(jsona <> *null : 'Newly created json array mustn''t be null.'); jsona_putBoolean(jsona : *on); iEqual(jsona_size(jsona) : 1); assert(jsona_getBoolean(jsona : 0) = *on : 'Wrong value for added boolean value.'); jsona_remove(jsona : 0); iEqual(jsona_size(jsona) : 0); jsona_putInt(jsona : 358); iEqual(jsona_getInt(jsona : 0) : 358); iEqual(jsona_size(jsona) : 1); jsona_putNull(jsona); iEqual(jsona_size(jsona) : 2); jsona_putString(jsona : 'Mihael'); iEqual(jsona_size(jsona) : 3); aEqual(%str(jsona_getString(jsona : 2)) : 'Mihael'); json_dispose(json); assert(json = *null : 'Dispose json object pointer must be *null.'); /end-free P E P test_size B export D PI * D array S * * /free array = jsona_create(); iEqual(jsona_size(array) : 0); jsona_putNull(array); iEqual(jsona_size(array) : 1); jsona_putString(array : 'Mihael'); iEqual(jsona_size(array) : 2); jsona_clear(array); iEqual(jsona_size(array) : 0); jsona_dispose(array); /end-free P E P test_addTypedValues... P B export * D array S * D object S * D array2 S * /free array = jsona_create(); array2 = jsona_create(); object = json_create(); json_putString(object : 'Mihael' : 'Schmidt'); jsona_putArray(array : array2); jsona_putObject(array : object); jsona_putBoolean(array : *on); jsona_putDouble(array : 1.2345); jsona_putInt(array : 358); jsona_putLong(array : 123456789012345); jsona_putNull(array); jsona_putString(array : 'Mihael'); jsona_putString(array : 'Mihael' : *omit : 4); jsona_putString(array : 'Mihael' : 8 : 2); iEqual(jsona_size(array) : 10); array2 = jsona_getArray(array : 0); assert(array2 <> *null : 'JSON array retrieved from array must exist.'); iEqual(jsona_size(array2) : 0); object = jsona_getObject(array : 1); assert(object <> *null : 'JSON object retrieved from array must exist.'); aEqual('Schmidt' : %str(json_getString(object : 'Mihael'))); assert(jsona_getBoolean(array : 2) : 'Retrieved boolean value doesn''t '+ 'match.'); assert(jsona_getDouble(array : 3) = 1.2345 : 'Retrieved double value ' + 'doesn''t match.'); assert(jsona_getInt(array : 4) = 358 : 'Retrieved int value doesn''t ' + 'match.'); assert(jsona_getLong(array : 5) = 123456789012345 : 'Retrieved ' + 'long value doesn''t match.'); assert(jsona_getEntryType(array : 6) = JSON_TYPE_NULL : 'JSON array ' + 'entry for previous inserted Null was not of type Null.'); assert(jsona_isNull(array : 6) : 'JSON array ' + 'entry for previous inserted Null was not Null.'); aEqual('Mihael' : %str(jsona_getString(array : 7))); aEqual('Mi' : %str(jsona_getString(array : 8))); aEqual('Miha' : %str(jsona_getString(array : 9))); jsona_dispose(array); /end-free P E P test_addTypedValuesPositioned... P B export * D array S * D object S * D array2 S * /free array = jsona_create(); array2 = jsona_create(); object = json_create(); json_putString(object : 'Mihael' : 'Schmidt'); jsona_putArray(array : array2); jsona_putObject(array : object); jsona_putBoolean(array : *on : 1); jsona_putDouble(array : 1.2345 : 1); jsona_putInt(array : 358 : 2); jsona_putLong(array : 123456789012345 : 4); jsona_putNull(array : 0); jsona_putString(array : 'Mihael' : 1); iEqual(jsona_size(array) : 8); array2 = jsona_getArray(array : 2); assert(array2 <> *null : 'JSON array retrieved from array must exist.'); iEqual(jsona_size(array2) : 0); object = jsona_getObject(array : 7); assert(object <> *null : 'JSON object retrieved from array must exist.'); aEqual('Schmidt' : %str(json_getString(object : 'Mihael'))); assert(jsona_getBoolean(array : 5) : 'Retrieved boolean value doesn''t '+ 'match.'); assert(jsona_getDouble(array : 3) = 1.2345 : 'Retrieved double value ' + 'doesn''t match.'); assert(jsona_getInt(array : 4) = 358 : 'Retrieved int value doesn''t ' + 'match.'); assert(jsona_getLong(array : 6) = 123456789012345 : 'Retrieved ' + 'long value doesn''t match.'); assert(jsona_getEntryType(array : 0) = JSON_TYPE_NULL : 'JSON array ' + 'entry for previous inserted Null was not of type Null.'); aEqual('Mihael' : %str(jsona_getString(array : 1))); jsona_dispose(array); /end-free P E json/unittest/Makefile 100666 241 0 3153 12005004323 12643 0 ustar 00IUSR0001 # # Makefile for JSON Unit Tests # #----------------------------------------------------------- # User-defined part start # # BIN_LIB is the destination library for the service program. # the rpg modules and the binder source file are also created in BIN_LIB. # binder source file and rpg module can be remove with the clean step (make clean) BIN_LIB=QGPL # to this library the prototype source file (copy book) is copied in the install step INCLUDE=/usr/local/include # CFLAGS = RPG compile parameter CFLAGS=DBGVIEW(*LIST) INCDIR('$(INCLUDE)') # LFLAGS = binding parameter # (make sure modules and service programs are in library list) LFLAGS=BNDDIR(QC2LE) BNDSRVPGM(JSON RUTESTCASE) FROM_CCSID=37 # # User-defined part end #----------------------------------------------------------- MODULES = json_ut_01 json_ut_02 json_par_1 json_ut_03 json_ut_04 OBJECTS = $(BIN_LIB)/JSON_UT_01 $(BIN_LIB)/JSON_UT_02 $(BIN_LIB)/JSON_UT_03 $(BIN_LIB)/JSON_UT_04 $(BIN_LIB)/JSON_PAR_1 .SUFFIXES: .rpgle .c .cpp # suffix rules .rpgle: system "CRTRPGMOD $(BIN_LIB)/$@ SRCSTMF('$<') $(CFLAGS)" system "crtsrvpgm $(BIN_LIB)/$@ MODULE($(BIN_LIB)/$@) export(*all) $(LFLAGS)" all: build .PHONY: build: $(MODULES) clean: -system "DLTMOD $(BIN_LIB)/JSON_UT_01" -system "DLTSRVPGM $(BIN_LIB)/JSON_UT_01" -system "DLTMOD $(BIN_LIB)/JSON_UT_02" -system "DLTSRVPGM $(BIN_LIB)/JSON_UT_02" -system "DLTMOD $(BIN_LIB)/JSON_UT_03" -system "DLTSRVPGM $(BIN_LIB)/JSON_UT_03" -system "DLTMOD $(BIN_LIB)/JSON_UT_04" -system "DLTSRVPGM $(BIN_LIB)/JSON_UT_04" -system "DLTMOD $(BIN_LIB)/JSON_PAR_1" -system "DLTSRVPGM $(BIN_LIB)/JSON_PAR_1" json/unittest/readme 100777 241 0 453 11612762571 12371 0 ustar 00IUSR0001 To run the unit tests you need the unit testing framework RPGUnit from Sourceforge.net (http://rpgunit.sourceforge.net). For the parser tests to run you need to set the current directory to the parsertest directory which comes with the source code, like CHGCURDIR '/usr/local/src/json/parsertest' json/unittest/json_ut_03.rpgle 100777 241 0 6766 11650774621 14265 0 ustar 00IUSR0001 /** * \brief JSON : Unit Test * * This unit test tests the toString() procedures of a JSON object and * JSON array. * * \author Mihael Schmidt * \date 23.10.2011 */ H nomain *------------------------------------------------------------------------- * Prototypes *------------------------------------------------------------------------- D test_toStringComplex... D PR /copy RPGUNIT1,TESTCASE /copy 'json/json_h.rpgle' /copy 'message_h.rpgle' /copy 'libc_h.rpgle' /** * \brief * * This test tests the toString() procedures with a complex JSON object * including nested objects and arrays. * *
*
* { "Product number" : 186189 ,
* "Product description": "After Eight 200gr" ,
* "In stock" : 52455 ; ' +
* "Distribution lock" : False ,
* "Cost" = 1.235 ,
* "Supplier" = 358 ,
* "Category" = { "Id" : 15 , "Description": "Sweets"},
* "Product line" : [
* {"Sweets" = "120.1.1." } ,
* {"Chocolate" = "120.1.2" } ] ,
* "Assigned stocks" = [ ] ,
* "Assigned display" = {}
* }
*
*/
P test_toStringComplex...
P B export
*
D item S *
D category S *
D plids S *
D plid S *
D json_string S 32000A varying
D ptr S *
/free
item = json_create();
json_putInt(item : 'product_number' : 186189);
json_putString(item : 'product_description' : 'After Eight 200gr');
json_putInt(item : 'in_stock' : 52445);
json_putBoolean(item : 'distribution_lock' : *off);
json_util_putDecimal(item : 'cost' : 1.235 : 4);
json_putInt(item : 'supplier' : 358);
category = json_create();
json_putInt(category : 'id' : 15);
json_putString(category : 'description' : 'sweets');
json_putObject(item : 'category' : category);
plids = jsona_create();
plid = json_create();
json_putString(plid : 'Sweets' : '120.1.1.');
jsona_putObject(plids : plid);
plid = json_create();
json_putString(plid : 'Chocolate' : '120.1.2.');
jsona_putObject(plids : plid);
json_putArray(item : 'product_lines' : plids);
json_putArray(item : 'assigned_stocks' : jsona_create());
json_putObject(item : 'assigned_display' : json_create());
ptr = json_toString(item);
json_string = ' {"product_number" : 186189 , "product_description" : ' +
'"After Eight 200gr" , "in_stock" : 52445 , ' +
'"distribution_lock" : false , "cost" : "1.2350" , ' +
'"supplier" : 358 , "category" : {"id" : 15 , ' +
'"description" : "sweets" } , "product_lines" : ' +
'[ {"Sweets" : "120.1.1." } , {"Chocolate" : ' +
'"120.1.2." } ] , "assigned_stocks" : [ ] , ' +
'"assigned_display" : { } } ' + x'00';
iEqual(strlen(%addr(json_string : *DATA)) : strlen(ptr));
iEqual(0 : strcmp(%addr(json_string : *DATA) : ptr));
json_dispose(item);
/end-free
P E
json/parsertest 42777 241 0 0 11707331125 11357 5 ustar 00IUSR0001 json/parsertest/test10.json 100777 241 0 535 11707333777 13551 0 ustar 00IUSR0001 {
"umlaute" : "Dieser Wert enthält die Umlaute: äöü." ,
"umlaute_unicode" : "\u0044\u0069\u0065\u0073\u0065\u0072\u0020\u0057\u0065\u0072\u0074\u0020\u0065\u006E\u0074\u0068\u00E4\u006C\u0074\u0020\u0064\u0069\u0065\u0020\u0055\u006D\u006C\u0061\u0075\u0074\u0065\u003A\u0020\u00E4\u00F6\u00FC\u002E" ,
"umlaute_raw" : "\u00E4\u00F6\u00FC"
}
json/parsertest/test8.json 100777 241 0 116 11612762573 13466 0 ustar 00IUSR0001 [
[ 200, 1, 1 ] ,
[ 200, 10, 10, 1 ],
[ 200, 11, 11, 1 ],
[]
] json/parsertest/test9.json 100777 241 0 20 11612762573 13441 0 ustar 00IUSR0001 [
{"id":358}
] json/parsertest/test1.json 100777 241 0 2 11612762573 13411 0 ustar 00IUSR0001 {} json/parsertest/test2.json 100777 241 0 23 11612762573 13435 0 ustar 00IUSR0001 { "key" : "value" } json/parsertest/test3.json 100777 241 0 226 11612762573 13463 0 ustar 00IUSR0001 {
"key1" : "value1" ,
"key2":"value2";
"key3" = 'value3';
'key4'='value4',
"special1" : true,
"special2" : false,
"special3" : null
} json/parsertest/test4.json 100777 241 0 240 11612762573 13460 0 ustar 00IUSR0001 {
"id" = 1 ,
"tax" = 19.0,
"nested object" = {
"subid" = 11,
"subsubobject" = {
"subid" = 111,
"value" = {}
}
}
} json/parsertest/test5.json 100777 241 0 163 11612762573 13465 0 ustar 00IUSR0001 {
"product line ids" = [
"200.1.1" ,
"200.1.2.1" ,
"200.10.10.1" ,
"200.11.11.1"
]
} json/parsertest/test6.json 100777 241 0 204 11612762573 13462 0 ustar 00IUSR0001 {
"product line ids" : [
[ 200, 1, 1 ] ,
[ 200, 10, 10, 1 ],
[ 200, 11, 11, 1 ],
[]
]
} json/parsertest/test7.json 100777 241 0 2 11612762573 13417 0 ustar 00IUSR0001 [] json/json_chk.c 100666 241 0 31654 11612762573 11342 0 ustar 00IUSR0001 /* JSON_checker.c */
/* 2007-08-24 */
/*
Copyright (c) 2005 JSON.org
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
The Software shall be used for Good, not Evil.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
*/
#include
* JSON (JavaScript Object Notation) is a lightweight data-interchange
* format. It is easy for humans to read and write. It is easy for
* machines to parse and generate. It is based on a subset of the
* JavaScript Programming Language, Standard ECMA-262 3rd Edition -
* December 1999. JSON is a text format that is completely language
* independent but uses conventions that are familiar to programmers
* of the C-family of languages, including C, C++, C#, Java, JavaScript,
* Perl, Python, and many others. These properties make JSON an ideal
* data-interchange language.
*
* These are universal data structures. Virtually all modern programming
* languages support them in one form or another. It makes sense that a
* data format that is interchangable with programming languages also be
* based on these structures.
*
* An object is an unordered set of name/value pairs. An object begins
* with { (left brace) and ends with } (right brace). Each name is followed
* by : (colon) and the name/value pairs are separated by , (comma).
*
* *off = invalid JSON string
*/
P json_validate B export
D PI N opdesc
D string 65535A const options(*varsize)
D ccsid 10I 0 const options(*nopass)
*
D iconv_table DS likeds(iconv_t)
D json_string_ptr...
D S *
D json_string S 65535A
D json_string_length...
D S 10U 0
D json_checker_ptr...
D S *
D json_checker DS likeds(tmpl_json_checker)
D based(json_checker_ptr)
*
D conv_ds DS
D unsInt 10U 0 inz(0)
D char 1A overlay(unsInt : 4)
*
D tmpLength S 10U 0
D i S 10I 0
D valid S N inz(*on)
/free
cee_getOpDescInfo(1 : cee_descType : cee_dataType : cee_descInfo1 :
cee_descInfo2 : cee_length : *omit);
json_string = %trim(%subst(string : 1 : cee_length)) + x'00';
json_string_ptr = %addr(json_string);
json_string_length = strlen(json_string_ptr);
tmpLength = json_string_length;
if (%parms() = 2);
iconv_from.ccsid = ccsid;
else;
iconv_from.ccsid = 0;
endif;
//
// translate the string from the current job ccsid (or passed ccsid)
// to ascii (819) because the checker only understands ascii
//
iconv_table = iconv_open(iconv_to : iconv_from);
if (iconv_table.return_value <> -1);
if (iconv(iconv_table :
json_string_ptr : tmpLength :
json_string_ptr : tmpLength) <> -1);
// create json checker
json_checker_ptr = json_new_checker(99);
// check string char by char
for i = 1 to json_string_length;
char = %subst(json_string : i : 1);
if (json_checker_char(json_checker_ptr : unsInt) = false);
sendDiagnosticMessage('JSON checker aborted at position ' +
%char(i) + '.');
valid = *off;
leave;
endif;
endfor;
// free memory
if (valid and json_checker_done(json_checker_ptr) = true);
valid = *on;
endif;
else;
sendDiagnosticMessage('Could not translate buffer from ccsid ' +
%char(iconv_from.ccsid) + ' to ccsid ' +
%char(iconv_to.ccsid) + '.');
valid = *off;
endif;
// cleanup
iconv_close(iconv_table);
else;
sendDiagnosticMessage('Could not init iconv.');
valid = *off;
endif;
return valid;
/end-free
P E
/**
* \brief Validate JSON file
*
* Validates the JSON string in the passed file. The file should only
* contain the JSON string. Comments are not supported.
*
* \author Mihael Schmidt
*
* \param IFS file path
* \param CCSID from the source string (default: 0 = Job CCSID)
*
* \return *on = valid JSON string
* *off = invalid JSON string
*/
P json_validateFile...
P B export
D PI N opdesc
D path 65535A const options(*varsize)
D ccsid 10I 0 const options(*nopass)
*
* file stuff
*
D filePath S 65535A
D fd S 10I 0
D dataPtr S *
D data S 1024A inz
D length S 10I 0
*
* translation stuff
*
D iconv_table DS likeds(iconv_t)
D json_string_ptr...
D S *
D json_string S 65535A
D json_checker_ptr...
D S *
D json_checker DS likeds(tmpl_json_checker)
D based(json_checker_ptr)
*
D conv_ds DS
D unsInt 10U 0 inz(0)
D char 1A overlay(unsInt : 4)
*
D tmpLength S 10U 0
D i S 10I 0
D valid S N inz(*on)
/free
cee_getOpDescInfo(1 : cee_descType : cee_dataType : cee_descInfo1 :
cee_descInfo2 : cee_length : *omit);
filePath = %trim(%subst(path : 1 : cee_length)) + x'00';
json_string_ptr = %addr(json_string);
dataPtr = %addr(data);
fd = open(filePath : O_RDONLY + O_TEXTDATA);
if (fd >= 0);
if (%parms() = 2);
iconv_from.ccsid = ccsid;
else;
iconv_from.ccsid = 0;
endif;
// create json checker
json_checker_ptr = json_new_checker(99);
//
// translate the string from the current job ccsid (or passed ccsid)
// to ascii (819) because the checker only understands ascii
//
iconv_table = iconv_open(iconv_to : iconv_from);
if (iconv_table.return_value <> -1);
length = read(fd : dataPtr : %size(data));
dow (length >= 1 and valid);
tmpLength = length;
if (iconv(iconv_table :
dataPtr : tmpLength :
json_string_ptr : tmpLength) <> -1);
// check string char by char
for i = 1 to length;
char = %subst(json_string : i : 1);
if (json_checker_char(json_checker_ptr : unsInt) = false);
sendDiagnosticMessage('JSON checker aborted at position ' +
%char(i) + '.');
valid = *off;
leave;
endif;
endfor;
else;
sendDiagnosticMessage('Could not translate buffer from ccsid ' +
%char(iconv_from.ccsid) + ' to ccsid ' +
%char(iconv_to.ccsid) + '.');
valid = *off;
endif;
length = read(fd : dataPtr : %size(data));
enddo;
else;
sendDiagnosticMessage('Could not init iconv.');
valid = *off;
endif;
// free memory
if (not valid or json_checker_done(json_checker_ptr) = false);
valid = *off;
endif;
// cleanup
iconv_close(iconv_table);
callp close(fd);
else;
sendDiagnosticMessage('Could not open file ' + %trim(filePath) + '.');
valid = *off;
endif;
return valid;
/end-free
P E
json/json_par.rpgle 100666 241 0 63533 11706734343 12245 0 ustar 00IUSR0001 /**
* \brief JSON Parser
*
* A utility module for parsing JSON strings.
*
*
*
* The parser string should be a valid JSON string or else and escape
* message will be sent to the caller.
*
*
*
* The parser also accepts the equal sign (=) as a separator for the key
* and the value. The parser also supports the ; instead of the , for
* separating pairs of values or values in an array. Strings may be
* enclosed in single or double quotes. Arrays can either be enclosed in
* curly braces () or in brackets []. Empty objects and arrays are supported.
* Unicode representation of a character is supported like \u00CF.
*
* \author Mihael Schmidt
* \date 2009-03-07
*
* \link http://www.json.org JSON.org
*
* \info The JSON syntax is not fully supported at the moment.
*
* \rev 09.04.2011 Mihael Schmidt
* Fixed parser error when newline characters follow a numeric value.
*
* \rev 23.07.2011 Matthias Aumüller
* Arrays only support (JSON array without JSON object)
*
* \rev 29.11.2011 Mihael Schmidt
* Fixed bug in next(). Memory address of 0 lead to MCH0601.
*
* \rev 22.01.2012 Mihael Schmidt
* Added support for TAB as whitespace (nextCleanChar)
*/
*-------------------------------------------------------------------------
* Copyright (c) 2007-2012 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*-------------------------------------------------------------------------
H nomain
H bnddir('QC2LE')
H copyright('Copyright (c) 2007-2011 Mihael Schmidt. All rights reserved.')
*---------------------------------------------------------------
* Constants
*---------------------------------------------------------------
D CR C const(u'000d') x'0d'
D LF C const(u'000a') x'25'
D NULL C const(x'00')
D TYPE_NO_VALUE C const(-1)
D TAB C const(u'0009')
D SPACE C const(u'0020')
*
/copy 'json_c.rpgle'
/copy 'unicode_c.rpgle'
*---------------------------------------------------------------
* Prototypes
*---------------------------------------------------------------
D nextValue PR
D retValPtr * const
D header *
D dataType 10I 0
*
D nextCleanChar PR 1A
D header *
*
D nextString PR 10000A
D header *
D quote 1A const
*
D nextObject PR *
D header *
*
D nextArray PR *
D header *
*
D next PR 1A
D header *
*
D back PR
D header *
*
D more PR N
D header *
*
D abortParsing PR
D header *
D message 1000A const
*
D strlen PR 10I 0 extproc('strlen')
D buffer1 * value
*
D strcasecmp PR 10I 0 extproc('strcasecmp')
D buffer1 * value
D buffer2 * value
*
D convertChar PR extproc('cvtch')
D target1byte * value
D source2byte * value options(*string)
D sourceBytes 10I 0 value
*
/copy 'json_h.rpgle'
*---------------------------------------------------------------
* Data structures
*---------------------------------------------------------------
D tmpl_parser_ds DS qualified based(nullPointer)
D json_string_ptr...
D *
D index_pos 10I 0
*
D tmpl_return_value_ds...
D DS qualified based(nullPointer)
D text 65535A
D boolean N overlay(text : 1)
D integer 10I 0 overlay(text : 1)
D long 20I 0 overlay(text : 1)
D double 8F overlay(text : 1)
D pointer * overlay(text : 1)
/**
* \brief Parse JSON string
*
* Creates a JSON object or array from the passed string. If the passed
* string is not a valid JSON string an escape message will be
* sent. The string must be null terminated.
*
* \param Pointer to JSON string
* \param Pointer to parser header (only for internal use)
*
* \return Pointer to JSON object or array
*/
P json_parse B export
D PI *
D string * const options(*omit)
D ptrHeader * const options(*nopass)
*
D ptr S *
D header DS likeds(tmpl_parser_ds) based(ptr)
D data S 1A
D json S *
/free
if (%parms() = 2);
// nested json object
ptr = ptrHeader;
data = UNICODE_LEFT_CURLY_BRACE;
else;
// first json object (top-level)
ptr = %alloc(%size(tmpl_parser_ds));
// init header ds
header.json_string_ptr = string;
header.index_pos = -1;
data = nextCleanChar(ptr);
endif;
if (data = UNICODE_LEFT_CURLY_BRACE);
json = nextObject(ptr);
elseif (data = UNICODE_LEFT_BRACKET or data = UNICODE_LEFT_BRACE);
json = nextArray(ptr);
else;
abortParsing(ptr : 'String is no JSON object or JSON array string');
endif;
// deallocate memory
if (%parms() = 1 and ptr <> *null);
dealloc ptr;
endif;
return json;
/end-free
P E
/**
* \brief Next value
*
* Returns the next value. The parser is moved after the next value.
* The returned value can be any supported JSON data type including array
* and object.
*
* \param Pointer to the return value data structure
* \param Pointer to the JSON string
* \param JSON data type of the return value
*/
P nextValue B
D PI
D retValPtr * const
D ptr *
D dataType 10I 0
*
D retValDs DS likeds(tmpl_return_value_ds)
D based(retValPtr)
D data S 1A
D backupData S 1A
D tmp S 65535A
D unquotedTextEnd...
D S 13A
*
D STRING_TRUE S 5A
D STRING_FALSE S 6A
D STRING_NULL S 5A
D numbers S 14A
*
D local_cr S 1A
D local_lf S 1A
D local_space S 1A
D local_tab S 1A
/free
local_cr = CR;
local_lf = LF;
local_space = SPACE;
local_tab = TAB;
// ,:]}/\''"[{;=#
unquotedTextEnd =u'002C003A005D007D002F005C00270022005B007B003B003D0023';
// 0123456789.,+-
numbers = u'0030003100320033003400350036003700380039002E002C002B002D';
STRING_TRUE = 'true' + NULL;
STRING_FALSE = 'false' + NULL;
STRING_NULL = 'null' + NULL;
data = nextCleanChar(ptr);
if (data = UNICODE_DOUBLE_QUOTE or data = UNICODE_APOSTROPHE);
// string
retValDs.text = nextString(ptr : data);
dataType = JSON_TYPE_STRING;
return;
elseif (data = UNICODE_LEFT_CURLY_BRACE);
// json object
retValDs.pointer = json_parse(*omit : ptr);
dataType = JSON_TYPE_OBJECT;
return;
elseif (data = UNICODE_LEFT_BRACKET or data = UNICODE_LEFT_BRACE);
// json array
retValDs.pointer = nextArray(ptr);
dataType = JSON_TYPE_ARRAY;
return;
elseif (data = UNICODE_RIGHT_BRACKET or data = UNICODE_RIGHT_BRACE);
dataType = TYPE_NO_VALUE;
return;
elseif (data = UNICODE_RIGHT_CURLY_BRACE);
dataType = TYPE_NO_VALUE;
return;
else;
//
// Handle unquoted text. This could be the values true, false, or
// null, or it can be a number. An implementation (such as this one)
// is allowed to also accept non-standard forms.
//
// Accumulate characters until we reach the end of the text or a
// formatting character.
//
backupData = data;
dow (%scan(data : unquotedTextEnd) = 0);
tmp = %trimr(tmp) + data;
data = next(ptr);
enddo;
back(ptr);
//
// If it is true, false, or null, return the proper value.
//
// remove CR and LF characters
// add null for string compare
tmp = %trimr(tmp : local_space + local_cr + local_lf + local_tab)+NULL;
if (strcasecmp(%addr(tmp) : %addr(STRING_TRUE)) = 0);
dataType = JSON_TYPE_BOOLEAN;
retValDs.boolean = *on;
return;
elseif (strcasecmp(%addr(tmp) : %addr(STRING_FALSE)) = 0);
dataType = JSON_TYPE_BOOLEAN;
retValDs.boolean = *off;
return;
elseif (strcasecmp(%addr(tmp) : %addr(STRING_NULL)) = 0);
dataType = JSON_TYPE_NULL;
return;
endif;
// remove null from tmp
tmp = %str(%addr(tmp));
//
// It should be a number
//
if (%scan(backupData : numbers) > 0);
// determine if integer or double
if (%scan('.' : tmp) > 0);
// is double
monitor;
dataType = JSON_TYPE_DOUBLE;
retValDs.double = %float(tmp);
return;
on-error *all;
// do nothing => value should be returned as string;
endmon;
else;
monitor;
dataType = JSON_TYPE_INT;
retValDs.integer = %int(tmp);
return;
on-error 0103;
monitor;
dataType = JSON_TYPE_LONG;
retValDs.long = %int(tmp);
return;
on-error *all;
// do nothing => value should be returned as string
// because it ain't parsable as number
endmon;
on-error 0202;
// do nothing => value should be returned as string
endmon;
endif;
endif;
//
// Ain't a number => return value as string
//
dataType = JSON_TYPE_STRING;
retValDs.text = tmp;
endif;
/end-free
P E
/**
* \brief Next clean character
*
* Moves the parser to the position on the next clean character and
* returns it to the caller. Character like carriage return, linefeed and
* blanks are ignored. On a null character an escape message will be sent.
*
* \param Pointer to the parser header structure
*
* \return next clean character
*/
P nextCleanChar B
D PI 1A
D ptr *
*
D header DS likeds(tmpl_parser_ds) based(ptr)
D data S 1A
D retVal S 1A
D keepLooping S N inz(*on)
/free
dow (keepLooping);
data = next(ptr);
if (data = *blank);
// loop
elseif (data = CR);
// loop
elseif (data = LF);
// loop
elseif (data = TAB);
// loop
elseif (data = NULL);
abortParsing(ptr : 'Unexpected ending of JSON string');
else;
keepLooping = *off;
endif;
enddo;
retVal = data;
return retVal;
/end-free
P E
/**
* \brief Next string
*
* Returns the next string from the current parser position on and moves
* the parser to the position behind the returned string.
*
* \param Pointer to the parser header structure
* \param Open quote character of the string (' or ")
*
* \return next JSON string
*/
P nextString B
D PI 10000A
D ptr *
D quote 1A const
*
D header DS likeds(tmpl_parser_ds) based(ptr)
D data S 1A
D keepLooping S N inz(*on)
D retVal S 10000A varying
D unicode S 1C
D unicodeCharRep S 4A
D allowedChars C 'ABCDEFabcdef0123456789'
/free
dow (keepLooping);
data = next(ptr);
if (data = CR);
// throw esc message (unterminated end)
abortParsing(ptr : 'Unterminated string (cr)');
elseif (data = LF);
// throw esc message (unterminated end)
abortParsing(ptr : 'Unterminated string (linefeed)');
elseif (data = NULL);
// throw esc message (unterminated end)
abortParsing(ptr : 'Unterminated string (null)');
elseif (data = quote); // end of string
keepLooping = *off;
elseif (data = UNICODE_BACKSLASH);
// check if we have an escape sequence
data = next(ptr);
if (data = UNICODE_DOUBLE_QUOTE);
retVal += %char(UNICODE_DOUBLE_QUOTE);
elseif (data = UNICODE_BACKSLASH);
retVal += %char(UNICODE_BACKSLASH);
elseif (data = UNICODE_SLASH);
retVal += %char(UNICODE_SLASH);
elseif (data = 'b');
retVal += x'16'; // backspace
elseif (data = 'f');
retVal += x'0c'; // form feed
elseif (data = 'n');
retVal += x'25'; // new line / line feed
elseif (data = 'r');
retVal += x'0d'; // carriage return
elseif (data = 't');
retVal += x'05'; // tab (horizontal)
elseif (data = 'u');
// add the next 4 character to the unicode char representation
unicodeCharRep = next(ptr) + next(ptr) + next(ptr) + next(ptr);
if (%check(allowedChars : unicodeCharRep) > 0);
abortParsing(ptr :'Incomplete unicode character representation');
endif;
convertChar(%addr(unicode) : %addr(unicodeCharRep) : 4);
retVal += %char(unicode);
else;
abortParsing(ptr : 'Invalid escape sequence \' + data);
endif;
else;
retVal += data;
endif;
enddo;
return retVal;
/end-free
P E
/**
* \brief Next JSON array
*
* Returns the JSON array which is at the next position in the JSON
* string. This procedure expects the position of the parser to be on
* the opening bracket of the array ( [ ). If there is no JSON array
* at the current position an escape message will be sent.
*
*
*
* Empty arrays are also supported.
*
* \param Pointer to the parser header structure
*
* \return Pointer to JSON array
*/
P nextArray B
D PI *
D ptr *
*
D header DS likeds(tmpl_parser_ds) based(ptr)
D array S *
D retValDs DS likeds(tmpl_return_value_ds)
D dataType S 10I 0
D data S 1A inz
D keepLooping S N inz(*on)
/free
array = jsona_create();
dow (keepLooping);
// Values are separated by ','. We will also tolerate ';'.
if (data = NULL);
abortParsing(ptr : 'A JSON array text must end with "]"');
elseif (data = UNICODE_RIGHT_BRACKET);
// end of array
leave;
elseif (data = UNICODE_COMMA);
// everything ok
elseif (data = UNICODE_SEMICOLON);
// everything ok
endif;
// arrays consists of values only
nextValue(%addr(retValDs) : ptr : dataType);
if (dataType = JSON_TYPE_STRING);
jsona_putString(array : %trimr(retValDs.text));
elseif (dataType = JSON_TYPE_BOOLEAN);
jsona_putBoolean(array : retValDs.boolean);
elseif (dataType = JSON_TYPE_NULL);
jsona_putNull(array);
elseif (dataType = JSON_TYPE_INT);
jsona_putInt(array : retValDs.integer);
elseif (dataType = JSON_TYPE_LONG);
jsona_putLong(array : retValDs.long);
elseif (dataType = JSON_TYPE_DOUBLE);
jsona_putDouble(array : retValDs.double);
elseif (dataType = JSON_TYPE_OBJECT);
jsona_putObject(array : retValDs.pointer);
elseif (dataType = JSON_TYPE_ARRAY);
jsona_putArray(array : retValDs.pointer);
elseif (dataType = TYPE_NO_VALUE);
leave;
endif;
// get next char
data = nextCleanChar(ptr);
// next iteration
enddo;
return array;
/end-free
P E
/**
* \brief Next character
*
* Returns the next character in the JSON string and moves the parser
* forward by one position.
*
* \param Pointer to parser header structure
*
* \return next character or null if there are no more characters
*/
P next B
D PI 1A
D ptrHead *
*
D header DS likeds(tmpl_parser_ds) based(ptrHead)
D ptr S *
D data S 1A based(ptr)
D retVal S 1A
/free
if (more(ptrHead));
ptr = header.json_string_ptr + 1 + header.index_pos;
retVal = data;
header.index_pos += 1;
else;
retVal = NULL;
endif;
return retVal;
/end-free
P E
/**
* \brief Move parser back
*
* Moves the position of the parser back by one position.
*
* \param Pointer to parser header structure
*/
P back B
D PI
D ptr *
*
D header DS likeds(tmpl_parser_ds) based(ptr)
/free
header.index_pos -= 1;
/end-free
P E
/**
* \brief Checks for more characters in string
*
* Checks if there are still more characters to parse in the given string.
*
* \param Pointer to the rest of the JSON string to be parsed
*/
P more B
D PI N
D ptr *
/free
if (strlen(ptr) = 0);
return *off;
else;
return *on;
endif;
/end-free
P E
/**
* \brief Abort parsing
*
* The memory of the parser header is deallocated (freed) and an
* escape message is sent to the previous call stack entry with the
* passed message text.
*
* \param Pointer to parser header
* \param Message text
*/
P abortParsing B
D PI
D ptr *
D message 1000A const
*
D sendProgramMessage...
D PR extpgm('QMHSNDPM')
D szMsgID 7A const
D szMsgFile 20A const
D szMsgData 6000A const options(*varsize)
D nMsgDataLen 10I 0 const
D szMsgType 10A const
D szCallStkEntry...
D 10A const
D nRelativeCallStkEntry...
D 10I 0 const
D szRtnMsgKey 4A
D error 265A options(*varsize)
*
D msgdata S 512A
D msgkey S 4A
D apiError S 265A
/free
// dispose header
dealloc(n) ptr;
// set message data
msgdata = message;
// send escape message
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*' :
1 :
msgkey :
apiError);
/end-free
P E
/**
* \brief Next JSON object
*
* Returns the JSON object which is at the next position in the JSON
* string. This procedure expects the position of the parser to be on
* the opening bracket of the array ( { ).
*
*
*
* Empty objects are supported.
*
* \param Pointer to the parser header structure
*
* \return Pointer to JSON object
*/
P nextObject B
D PI *
D ptr *
*
D json S *
D key S 10000A
*
D header DS likeds(tmpl_parser_ds) based(ptr)
*
D retValDs DS likeds(tmpl_return_value_ds)
D dataType S 10I 0
D data S 1A
D keepLooping S N inz(*on)
/free
json = json_create();
dow (keepLooping);
data = nextCleanChar(ptr);
if (data = NULL);
abortParsing(ptr : 'A JSON object text must end with ' +
%char(UNICODE_RIGHT_CURLY_BRACE));
elseif (data = UNICODE_RIGHT_CURLY_BRACE);
leave;
else;
// should be a key
back(ptr);
nextValue(%addr(retValDs) : ptr : dataType);
if (dataType <> JSON_TYPE_STRING);
abortParsing(ptr : 'Key is not of type string');
endif;
key = retValDs.text;
// The key is followed by ':'. We will also tolerate '='.
data = nextCleanChar(ptr);
if (data <> UNICODE_COLON and data <> UNICODE_EQUAL);
abortParsing(ptr : 'Expected a colon after a key');
endif;
// A value should be following
nextValue(%addr(retValDs) : ptr : dataType);
if (dataType = JSON_TYPE_STRING);
json_putString(json : %trimr(key) : %trimr(retValDs.text));
elseif (dataType = JSON_TYPE_BOOLEAN);
json_putBoolean(json : %trimr(key) : retValDs.boolean);
elseif (dataType = JSON_TYPE_NULL);
json_putNull(json : %trimr(key));
elseif (dataType = JSON_TYPE_INT);
json_putInt(json : %trimr(key) : retValDs.integer);
elseif (dataType = JSON_TYPE_LONG);
json_putLong(json : %trimr(key) : retValDs.long);
elseif (dataType = JSON_TYPE_DOUBLE);
json_putDouble(json : %trimr(key) : retValDs.double);
elseif (dataType = JSON_TYPE_OBJECT);
json_putObject(json : %trimr(key) : retValDs.pointer);
elseif (dataType = JSON_TYPE_ARRAY);
json_putArray(json : %trimr(key) : retValDs.pointer);
endif;
// Pairs are separated by ','. We will also tolerate ';'.
data = nextCleanChar(ptr);
if (data = UNICODE_COMMA);
// everything ok
elseif (data = UNICODE_SEMICOLON);
// everything ok
elseif (data = UNICODE_RIGHT_CURLY_BRACE); // end of object
leave;
abortParsing(ptr : 'Expected a comma or right curly brace ' +
'after value');
endif;
// next iteration => next key/value pair
endif;
enddo;
return json;
/end-free
P E
json/json_c.rpgle 100666 241 0 4606 11612762573 11663 0 ustar 00IUSR0001 /if not defined (JSON_C)
/define JSON_C
/*
* Copyright (c) 2007-2010 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
*-------------------------------------------------------------------------
* Constants
*-------------------------------------------------------------------------
*
* Message IDs
*
D MSG_NO_JSON_OBJECT...
D C 1
D MSG_ENTRY_TYPE_MISMATCH...
D C 2
D MSG_ARRAY_ELEMENT_NOT_FOUND...
D C 3
D MSG_TYPE_CAST_EXCEPTION...
D C 4
D MSG_FILE_OUTPUT_ERROR...
D C 5
D MSG_ENTRY_NOT_FOUND...
D C 6
*
* Types
*
D JSON_TYPE_BOOLEAN...
D C 1
D JSON_TYPE_INT C 2
D JSON_TYPE_LONG C 3
D JSON_TYPE_DOUBLE...
D C 4
D JSON_TYPE_STRING...
D C 5
D JSON_TYPE_ARRAY...
D C 6
D JSON_TYPE_OBJECT...
D C 7
D JSON_TYPE_NULL C 8
*
* Output types
*
D JSON_OUTPUT_NORMAL...
D C 0
D JSON_OUTPUT_PRETTY_PRINT...
D C 1
D JSON_OUTPUT_COMPACT...
D C 2
/endif
json/json_chk.h 100666 241 0 2316 11612762573 11320 0 ustar 00IUSR0001 /*
* Copyright (c) 2007-2009 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
/* JSON_CHK_H.RPGLE */
typedef struct json_checker_struct {
int state;
int depth;
int top;
int* stack;
} * JSON_checker;
extern JSON_checker json_new_checker(int depth);
extern int json_checker_char(JSON_checker jc, int next_char);
extern int json_checker_done(JSON_checker jc);
json/json_util_h.rpgle 100666 241 0 13255 11612762573 12745 0 ustar 00IUSR0001 /if not defined(JSON_UTL_H)
/define JSON_UTL_H
*-------------------------------------------------------------------------
* Prototypes : JSON Utilities
*-------------------------------------------------------------------------
D json_util_getDate...
D PR D extproc('json_util_getDate') opdesc
D json * const
D key 65535A const options(*varsize)
*
D json_util_putDate...
D PR extproc('json_util_putDate') opdesc
D json * const
D key 65535A const options(*varsize)
D value D const
*
D jsona_util_getDate...
D PR D extproc('jsona_util_getDate')
D json * const
D index 10U 0 const
*
D jsona_util_putDate...
D PR extproc('jsona_util_putDate')
D json * const
D value D const
D index 10U 0 const options(*nopass)
*
D json_util_fromFile...
D PR * extproc('json_util_fromFile')
D filePath 1024A const
D pDeleteFile N const options(*nopass)
*
D json_util_toFile...
D PR extproc('json_util_toFile')
D json * const
D filePath 1024A const
D pCcsid 10I 0 const options(*nopass : *omit)
D pDeleteFile N const options(*nopass : *omit)
D pOutputFormat...
D 10I 0 const options(*nopass)
D pPrettyPrintFormat...
D likeds(json_prettyPrintFormat)
D const options(*nopass)
*
D json_util_putDecimal...
D PR extproc('json_util_putDecimal')
D opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 30P10 const
D pDecimalPositions...
D 2P 0 const options(*nopass)
*
D json_util_getDecimal...
D PR 30P10 extproc('json_util_getDecimal')
D opdesc
D json * const
D key 65535A const options(*varsize)
*
D jsona_util_putDecimal...
D PR extproc('jsona_util_putDecimal')
D json * const
D value 30P10 const
D decimalPositions...
D 2P 0 const options(*nopass : *omit)
D index 10U 0 const options(*nopass)
*
D jsona_util_getDecimal...
D PR 30P10 extproc('jsona_util_getDecimal')
D json * const
D index 10U 0 const
*
D json_util_getTime...
D PR T extproc('json_util_getTime') opdesc
D json * const
D key 65535A const options(*varsize)
*
D json_util_putTime...
D PR extproc('json_util_putTime') opdesc
D json * const
D key 65535A const options(*varsize)
D value T const
*
D jsona_util_getTime...
D PR T extproc('jsona_util_getTime')
D json * const
D index 10U 0 const
*
D jsona_util_putTime...
D PR extproc('jsona_util_putTime')
D json * const
D value T const
D index 10U 0 const options(*nopass)
*
D json_util_getTimestamp...
D PR Z extproc('json_util_getTimestamp')
D opdesc
D json * const
D key 65535A const options(*varsize)
*
D json_util_putTimestamp...
D PR extproc('json_util_putTimestamp')
D opdesc
D json * const
D key 65535A const options(*varsize)
D value Z const
*
D jsona_util_getTimestamp...
D PR Z extproc('jsona_util_getTimestamp')
D json * const
D index 10U 0 const
*
D jsona_util_putTimestamp...
D PR extproc('jsona_util_putTimestamp')
D json * const
D value Z const
D index 10U 0 const options(*nopass)
*
D json_util_dsToJsonObject...
D PR * extproc('json_util_dsToJsonObject')
D dataStructure...
D 65535A options(*varsize)
D qualifiedFileName...
D 20A const
/endif
json/libc_h.rpgle 100666 241 0 11734 11612762573 11650 0 ustar 00IUSR0001 *-------------------------------------------------------------------------
* Prototypes for C functions
*-------------------------------------------------------------------------
/if not defined(QUSEC)
/define QUSEC
/include QSYSINC/QRPGLESRC,QUSEC
/endif
*
* strings
*
D strtok PR * extproc('strtok')
D i_string * value options(*string)
D i_token * value options(*string)
*
D strlen PR 10U 0 extproc('strlen')
D string * value
*
D requestControlBlockLower...
D DS qualified
D type 10I 0 inz(0)
D ccsid 10I 0 inz(0)
D case 10I 0 inz(0)
D res1 10A inz(*ALLX'00')
*
D requestControlBlockUpper...
D DS qualified
D type 10I 0 inz(1)
D ccsid 10I 0 inz(0)
D case 10I 0 inz(0)
D res1 10A inz(*ALLX'00')
*
D caseConvert PR extproc('QlgConvertCase')
D reqContBlock const
D likeds(requestControlBlockUpper)
D input 1024A const options(*varsize)
D output 1024A options(*varsize)
D len 10I 0 const
D errorcode likeds(QUSEC) options(*varsize)
*
* memory handling
*
D memcpy PR * extproc('memcpy')
D dest * value
D source * value
D count 10U 0 value
*
D memset PR * extproc('memset')
D i_pDest * value
D i_char 10I 0 value
D i_count 10U 0 value
*
D memmove PR * extproc('memmove')
D pMemDest * value
D pMemSrc * value
D memSize 10U 0 value
*
D memcmp PR 10I 0 extproc('memcmp')
D pBuf1 * value
D pBuf2 * value
D count 10U 0 value
*
D memicmp PR 10I 0 extproc('__memicmp')
D pBuf1 * value
D pBuf2 * value
D count 10U 0 value
*
* Math
*
D ceil PR 8F extproc('ceil')
D value 8F value
*
D floor PR 8F extproc('floor')
D value 8F value
*
* Date and time
*
D time PR 10I 0 extproc('time')
D timeptr * value
*
D time_ds DS qualified based(nullPointer)
D seconds 10I 0
D minutes 10I 0
D hours 10I 0
D day 10I 0
D month 10I 0
D year 10I 0
D weekday 10I 0
D dayOfYear 10I 0
D isDST 10I 0
*
* Misc
*
D tmpnam PR * extproc('tmpnam')
D buffer 39A options(*omit)
*
D tmpnamIFS PR * extproc('_C_IFS_tmpnam')
D buffer 39A options(*omit)
*
D system PR 10I 0 extproc('system')
D command * value options(*string)
*
D sleep PR 10U 0 extproc('sleep')
D seconds 10U 0 value
*
D srand PR extproc('srand')
D i_seed 10U 0 value
*
D rand PR 10I 0 extproc('rand')
*
D qsort PR * extproc('qsort')
D memPtr * value
D numElem 10U 0 value
D width 10U 0 value
D pSortFunc * value procptr
*
D bsearch PR * extproc('bsearch')
D keyPtr * value
D memPtr * value
D numElem 10U 0 value
D width 10U 0 value
D pSearchFnc * value procptr
json/ifsio_h.rpgle 100666 241 0 160511 11612762573 12066 0 ustar 00IUSR0001 D/if defined(IFSIO_H)
D/eof
D/endif
D/define IFSIO_H
**********************************************************************
* Some CCSID definitions that I've found useful
**********************************************************************
D CP_MSDOS C 437
D CP_ISO8859_1 C 819
D CP_WINDOWS C 1252
D CP_UTF8 C 1208
D CP_UCS2 C 1200
D CP_CURJOB C 0
**********************************************************************
* Flags for use in open()
*
* More than one can be used -- add them together.
**********************************************************************
* 00000000000000000000000000000001 Reading Only
D O_RDONLY C 1
* 00000000000000000000000000000010 Writing Only
D O_WRONLY C 2
* 00000000000000000000000000000100 Reading & Writing
D O_RDWR C 4
* 00000000000000000000000000001000 Create File if needed
D O_CREAT C 8
* 00000000000000000000000000010000 Exclusively create --
* open will fail if it
* already exists.
D O_EXCL C 16
* 00000000000000000000000000100000 Assign a CCSID to new
* file.
D O_CCSID C 32
* 00000000000000000000000001000000 Truncate file to 0 bytes
D O_TRUNC C 64
* 00000000000000000000000100000000 Append to file
* (write data at end only)
D O_APPEND C 256
* 00000000000000000000010000000000 Synchronous write
D O_SYNC C 1024
* 00000000000000000000100000000000 Sync write, data only
D O_DSYNC C 2048
* 00000000000000000001000000000000 Sync read
D O_RSYNC C 4096
* 00000000000000001000000000000000 No controlling terminal
D O_NOCTTY C 32768
* 00000000000000010000000000000000 Share with readers only
D O_SHARE_RDONLY C 65536
* 00000000000000100000000000000000 Share with writers only
D O_SHARE_WRONLY C 131072
* 00000000000001000000000000000000 Share with read & write
D O_SHARE_RDWR C 262144
* 00000000000010000000000000000000 Share with nobody.
D O_SHARE_NONE C 524288
* 00000000100000000000000000000000 Assign a code page
D O_CODEPAGE C 8388608
* 00000001000000000000000000000000 Open in text-mode
D O_TEXTDATA C 16777216
/if defined(*V5R2M0)
* 00000010000000000000000000000000 Allow text translation
* on newly created file.
* Note: O_TEXT_CREAT requires all of the following flags to work:
* O_CREAT+O_TEXTDATA+(O_CODEPAGE or O_CCSID)
D O_TEXT_CREAT C 33554432
/endif
* 00001000000000000000000000000000 Inherit mode from dir
D O_INHERITMODE C 134217728
* 00100000000000000000000000000000 Large file access
* (for >2GB files)
D O_LARGEFILE C 536870912
**********************************************************************
* Access mode flags for access() and accessx()
*
* F_OK = File Exists
* R_OK = Read Access
* W_OK = Write Access
* X_OK = Execute or Search
**********************************************************************
D F_OK C 0
D R_OK C 4
D W_OK C 2
D X_OK C 1
**********************************************************************
* class of users flags for accessx()
*
* ACC_SELF = Check access based on effective uid/gid
* ACC_INVOKER = Check access based on real uid/gid
* ( this is equvalent to calling access() )
* ACC_OTHERS = Check access of someone not the owner
* ACC_ALL = Check access of all users
**********************************************************************
D ACC_SELF C 0
D ACC_INVOKER C 1
D ACC_OTHERS C 8
D ACC_ALL C 32
**********************************************************************
* Mode Flags.
* basically, the mode parm of open(), creat(), chmod(),etc
* uses 9 least significant bits to determine the
* file's mode. (peoples access rights to the file)
*
* user: owner group other
* access: R W X R W X R W X
* bit: 8 7 6 5 4 3 2 1 0
*
* (This is accomplished by adding the flags below to get the mode)
**********************************************************************
* owner authority
D S_IRUSR C 256
D S_IWUSR C 128
D S_IXUSR C 64
D S_IRWXU C 448
* group authority
D S_IRGRP C 32
D S_IWGRP C 16
D S_IXGRP C 8
D S_IRWXG C 56
* other people
D S_IROTH C 4
D S_IWOTH C 2
D S_IXOTH C 1
D S_IRWXO C 7
* special modes:
* Set effective GID
D S_ISGID C 1024
* Set effective UID
D S_ISUID C 2048
**********************************************************************
* My own special MODE shortcuts for open() (instead of those above)
**********************************************************************
D M_RDONLY C const(292)
D M_RDWR C const(438)
D M_RWX C const(511)
**********************************************************************
* "whence" constants for use with seek(), lseek() and others
**********************************************************************
D SEEK_SET C CONST(0)
D SEEK_CUR C CONST(1)
D SEEK_END C CONST(2)
**********************************************************************
* flags specified in the f_flags element of the ds_statvfs
* data structure used by the statvfs() API
**********************************************************************
D ST_RDONLY...
D C CONST(1)
D ST_NOSUID...
D C CONST(2)
D ST_CASE_SENSITITIVE...
D C CONST(4)
D ST_CHOWN_RESTRICTED...
D C CONST(8)
D ST_THREAD_SAFE...
D C CONST(16)
D ST_DYNAMIC_MOUNT...
D C CONST(32)
D ST_NO_MOUNT_OVER...
D C CONST(64)
D ST_NO_EXPORTS...
D C CONST(128)
D ST_SYNCHRONOUS...
D C CONST(256)
**********************************************************************
* Constants used by pathconf() API
**********************************************************************
D PC_CHOWN_RESTRICTED...
D C 0
D PC_LINK_MAX...
D C 1
D PC_MAX_CANON...
D C 2
D PC_MAX_INPUT...
D C 3
D PC_NAME_MAX...
D C 4
D PC_NO_TRUNC...
D C 5
D PC_PATH_MAX...
D C 6
D PC_PIPE_BUF...
D C 7
D PC_VDISABLE...
D C 8
D PC_THREAD_SAFE...
D C 9
**********************************************************************
* Constants used by sysconf() API
**********************************************************************
D SC_CLK_TCK...
D C 2
D SC_NGROUPS_MAX...
D C 3
D SC_OPEN_MAX...
D C 4
D SC_STREAM_MAX...
D C 5
D SC_CCSID...
D C 10
D SC_PAGE_SIZE...
D C 11
D SC_PAGESIZE...
D C 12
**********************************************************************
* File Information Structure (stat)
* struct stat {
* mode_t st_mode; /* File mode */
* ino_t st_ino; /* File serial number */
* nlink_t st_nlink; /* Number of links */
* unsigned short st_reserved2; /* Reserved @B4A*/
* uid_t st_uid; /* User ID of the owner of file */
* gid_t st_gid; /* Group ID of the group of file */
* off_t st_size; /* For regular files, the file
* size in bytes */
* time_t st_atime; /* Time of last access */
* time_t st_mtime; /* Time of last data modification */
* time_t st_ctime; /* Time of last file status change */
* dev_t st_dev; /* ID of device containing file */
* size_t st_blksize; /* Size of a block of the file */
* unsigned long st_allocsize; /* Allocation size of the file */
* qp0l_objtype_t st_objtype; /* AS/400 object type */
* char st_reserved3; /* Reserved @B4A*/
* unsigned short st_codepage; /* Object data codepage */
* unsigned short st_ccsid; /* Object data ccsid @AAA*/
* dev_t st_rdev; /* Device ID (if character special */
* /* or block special file) @B4A*/
* nlink32_t st_nlink32; /* Number of links-32 bit @B5C*/
* dev64_t st_rdev64; /* Device ID - 64 bit form @B4A*/
* dev64_t st_dev64; /* ID of device containing file - */
* /* 64 bit form. @B4A*/
* char st_reserved1[36]; /* Reserved @B4A*/
* unsigned int st_ino_gen_id; /* File serial number generation id
* };
* @A2A*/
**********************************************************************
D statds DS qualified
D BASED(Template)
D st_mode 10U 0
D st_ino 10U 0
D st_nlink 5U 0
D st_reserved2 5U 0
D st_uid 10U 0
D st_gid 10U 0
D st_size 10I 0
D st_atime 10I 0
D st_mtime 10I 0
D st_ctime 10I 0
D st_dev 10U 0
D st_blksize 10U 0
D st_allocsize 10U 0
D st_objtype 11A
D st_reserved3 1A
D st_codepage 5U 0
D st_ccsid 5U 0
D st_rdev 10U 0
D st_nlink32 10U 0
D st_rdev64 20U 0
D st_dev64 20U 0
D st_reserved1 36A
D st_ino_gen_id 10U 0
**********************************************************************
* File Information Structure, Large File Enabled (stat64)
* struct stat64 { */
* mode_t st_mode; /* File mode */
* ino_t st_ino; /* File serial number */
* uid_t st_uid; /* User ID of the owner of file */
* gid_t st_gid; /* Group ID of the group of fileA2A*/
* off64_t st_size; /* For regular files, the file */
* size in bytes */
* time_t st_atime; /* Time of last access */
* time_t st_mtime; /* Time of last data modification2A*/
* time_t st_ctime; /* Time of last file status changeA*/
* dev_t st_dev; /* ID of device containing file */
* size_t st_blksize; /* Size of a block of the file */
* nlink_t st_nlink; /* Number of links */
* unsigned short st_codepage; /* Object data codepage */
* unsigned long long st_allocsize; /* Allocation size of the file2A*/
* unsigned int st_ino_gen_id; /* File serial number generationAid*/
* */
* qp0l_objtype_t st_objtype; /* AS/400 object type */
* char st_reserved2[5]; /* Reserved @B4A*/
* dev_t st_rdev; /* Device ID (if character specialA*/
* /* or block special file) @B4A*/
* dev64_t st_rdev64; /* Device ID - 64 bit form @B4A*/
* dev64_t st_dev64; /* ID of device containing file@-2A*/
* /* 64 bit form. @B4A*/
* nlink32_t st_nlink32; /* Number of links-32 bit @B5A*/
* char st_reserved1[26]; /* Reserved @B4A @B5C*/
* unsigned short st_ccsid; /* Object data ccsid @AAA*/
* }; */
*
**********************************************************************
D statds64 DS qualified
D BASED(Template)
D st_mode 10U 0
D st_ino 10U 0
D st_uid 10U 0
D st_gid 10U 0
D st_size 20I 0
D st_atime 10I 0
D st_mtime 10I 0
D st_ctime 10I 0
D st_dev 10U 0
D st_blksize 10U 0
D st_nlink 5U 0
D st_codepage 5U 0
D st_allocsize 20U 0
D st_ino_gen_id 10U 0
D st_objtype 11A
D st_reserved2 5A
D st_rdev 10U 0
D st_rdev64 20U 0
D st_dev64 20U 0
D st_nlink32 10U 0
D st_reserved1 26A
D st_ccsid 5U 0
**********************************************************************
* ds_statvfs - data structure to receive file system info
*
* f_bsize = file system block size (in bytes)
* f_frsize = fundamental block size in bytes.
* if this is zero, f_blocks, f_bfree and f_bavail
* are undefined.
* f_blocks = total number of blocks (in f_frsize)
* f_bfree = total free blocks in filesystem (in f_frsize)
* f_bavail = total blocks available to users (in f_frsize)
* f_files = total number of file serial numbers
* f_ffree = total number of unused file serial numbers
* f_favail = number of available file serial numbers to users
* f_fsid = filesystem ID. This will be 4294967295 if it's
* too large for a 10U 0 field. (see f_fsid64)
* f_flag = file system flags (see below)
* f_namemax = max filename length. May be 4294967295 to
* indicate that there is no maximum.
* f_pathmax = max pathname legnth. May be 4294967295 to
* indicate that there is no maximum.
* f_objlinkmax = maximum number of hard-links for objects
* other than directories
* f_dirlinkmax = maximum number of hard-links for directories
* f_fsid64 = filesystem id (in a 64-bit integer)
* f_basetype = null-terminated string containing the file
* system type name. For example, this might
* be "root" or "Network File System (NFS)"
*
* Since f_basetype is null-terminated, you should read it
* in ILE RPG with:
* myString = %str(%addr(ds_statvfs.f_basetype))
**********************************************************************
D ds_statvfs DS qualified
D BASED(Template)
D f_bsize 10U 0
D f_frsize 10U 0
D f_blocks 20U 0
D f_bfree 20U 0
D f_bavail 20U 0
D f_files 10U 0
D f_ffree 10U 0
D f_favail 10U 0
D f_fsid 10U 0
D f_flag 10U 0
D f_namemax 10U 0
D f_pathmax 10U 0
D f_objlinkmax 10I 0
D f_dirlinkmax 10I 0
D f_reserved1 4A
D f_fsid64 20U 0
D f_basetype 80A
**********************************************************************
* Group Information Structure (group)
*
* struct group {
* char *gr_name; /* Group name. */
* gid_t gr_gid; /* Group id. */
* char **gr_mem; /* A null-terminated list of pointers
* to the individual member names. */
* };
*
**********************************************************************
D group DS qualified
D BASED(Template)
D gr_name *
D gr_gid 10U 0
D gr_mem * DIM(256)
**********************************************************************
* User Information Structure (passwd)
*
* (Don't let the name fool you, this structure does not contain
* any password information. Its named after the UNIX file that
* contains all of the user info. That file is "passwd")
*
* struct passwd {
* char *pw_name; /* User name. */
* uid_t pw_uid; /* User ID number. */
* gid_t pw_gid; /* Group ID number. */
* char *pw_dir; /* Initial working directory. */
* char *pw_shell; /* Initial user program. */
* };
*
**********************************************************************
D passwd DS qualified
D BASED(Template)
D pw_name *
D pw_uid 10U 0
D pw_gid 10U 0
D pw_dir *
D pw_shell *
**********************************************************************
* File Time Structure (utimbuf)
*
* struct utimbuf {
* time_t actime; /* access time */
* time_t modtime; /* modification time */
* };
*
**********************************************************************
D utimbuf DS qualified
D BASED(Template)
D actime 10I 0
D modtime 10I 0
**********************************************************************
* Directory Entry Structure (dirent)
*
* struct dirent {
* char d_reserved1[16]; /* Reserved */
* unsigned int d_fileno_gen_id /* File number generation ID @A1C*/
* ino_t d_fileno; /* The file number of the file */
* unsigned int d_reclen; /* Length of this directory entry
* * in bytes */
* int d_reserved3; /* Reserved */
* char d_reserved4[8]; /* Reserved */
* qlg_nls_t d_nlsinfo; /* National Language Information
* * about d_name */
* unsigned int d_namelen; /* Length of the name, in bytes
* * excluding NULL terminator */
* char d_name[_QP0L_DIR_NAME]; /* Name...null terminated */
*
* };
**********************************************************************
D dirent ds qualified
D BASED(Template)
D d_reserv1 16A
D d_fileno_gen_id...
D 10U 0
D d_fileno 10U 0
D d_reclen 10U 0
D d_reserv3 10I 0
D d_reserv4 8A
D d_nlsinfo 12A
D d_nls_ccsid 10I 0 OVERLAY(d_nlsinfo:1)
D d_nls_cntry 2A OVERLAY(d_nlsinfo:5)
D d_nls_lang 3A OVERLAY(d_nlsinfo:7)
D d_namelen 10U 0
D d_name 640A
**********************************************************************
* I/O Vector Structure
*
* struct iovec {
* void *iov_base;
* size_t iov_len;
* }
**********************************************************************
D iovec DS qualified
D BASED(Template)
D iov_base *
D iov_len 10U 0
*--------------------------------------------------------------------
* Determine file accessibility
*
* int access(const char *path, int amode)
*
*--------------------------------------------------------------------
D access PR 10I 0 ExtProc('access')
D Path * Value Options(*string)
D amode 10I 0 Value
*--------------------------------------------------------------------
* Determine file accessibility for a class of users
*
* int accessx(const char *path, int amode, int who);
*
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D accessx PR 10I 0 ExtProc('accessx')
D Path * Value Options(*string)
D amode 10I 0 Value
D who 10I 0 value
/endif
*--------------------------------------------------------------------
* Change Directory
*
* int chdir(const char *path)
*--------------------------------------------------------------------
D chdir PR 10I 0 ExtProc('chdir')
D path * Value Options(*string)
*--------------------------------------------------------------------
* Change file authorizations
*
* int chmod(const char *path, mode_t mode)
*--------------------------------------------------------------------
D chmod PR 10I 0 ExtProc('chmod')
D path * Value options(*string)
D mode 10U 0 Value
*--------------------------------------------------------------------
* Change Owner/Group of File
*
* int chown(const char *path, uid_t owner, gid_t group)
*--------------------------------------------------------------------
D chown PR 10I 0 ExtProc('chown')
D path * Value options(*string)
D owner 10U 0 Value
D group 10U 0 Value
*--------------------------------------------------------------------
* Close a file
*
* int close(int fildes)
*
* Note: Because the same close() API is used for IFS, sockets,
* and pipes, it's conditionally defined here. If it's
* done the same in the sockets & pipe /copy members,
* there will be no conflict.
*--------------------------------------------------------------------
D/if not defined(CLOSE_PROTOTYPE)
D close PR 10I 0 ExtProc('close')
D fildes 10I 0 value
D/define CLOSE_PROTOTYPE
D/endif
*--------------------------------------------------------------------
* Close a directory
*
* int closedir(DIR *dirp)
*--------------------------------------------------------------------
D closedir PR 10I 0 EXTPROC('closedir')
D dirp * VALUE
*--------------------------------------------------------------------
* Create or Rewrite File
*
* int creat(const char *path, mode_t mode)
*
* DEPRECATED: Use open() instead.
*--------------------------------------------------------------------
D creat PR 10I 0 ExtProc('creat')
D path * Value options(*string)
D mode 10U 0 Value
*--------------------------------------------------------------------
* Duplicate open file descriptor
*
* int dup(int fildes)
*--------------------------------------------------------------------
D dup PR 10I 0 ExtProc('dup')
D fildes 10I 0 Value
*--------------------------------------------------------------------
* Duplicate open file descriptor to another descriptor
*
* int dup2(int fildes, int fildes2)
*--------------------------------------------------------------------
D dup2 PR 10I 0 ExtProc('dup2')
D fildes 10I 0 Value
D fildes2 10I 0 Value
*--------------------------------------------------------------------
* Determine file accessibility for a class of users by descriptor
*
* int faccessx(int filedes, int amode, int who)
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D faccessx PR 10I 0 ExtProc('faccessx')
D fildes 10I 0 Value
D amode 10I 0 Value
D who 10I 0 Value
/endif
*--------------------------------------------------------------------
* Change Current Directory by Descriptor
*
* int fchdir(int fildes)
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D fchdir PR 10I 0 ExtProc('fchdir')
D fildes 10I 0 value
/endif
*--------------------------------------------------------------------
* Change file authorizations by descriptor
*
* int fchmod(int fildes, mode_t mode)
*--------------------------------------------------------------------
D fchmod PR 10I 0 ExtProc('fchmod')
D fildes 10I 0 Value
D mode 10U 0 Value
*--------------------------------------------------------------------
* Change Owner and Group of File by Descriptor
*
* int fchown(int fildes, uid_t owner, gid_t group)
*--------------------------------------------------------------------
D fchown PR 10I 0 ExtProc('fchown')
D fildes 10I 0 Value
D owner 10U 0 Value
D group 10U 0 Value
*--------------------------------------------------------------------
* Perform File Control
*
* int fcntl(int fildes, int cmd, . . .)
*
* Note: Because the same fcntl() API is used for IFS and sockets,
* it's conditionally defined here. If it's defined with
* the same conditions in the sockets /copy member, there
* will be no conflict.
*--------------------------------------------------------------------
D/if not defined(FCNTL_PROTOTYPE)
D fcntl PR 10I 0 ExtProc('fcntl')
D fildes 10I 0 Value
D cmd 10I 0 Value
D arg 10I 0 Value options(*nopass)
D/define FCNTL_PROTOTYPE
D/endif
*--------------------------------------------------------------------
* Get configurable path name variables by descriptor
*
* long fpathconf(int fildes, int name)
*--------------------------------------------------------------------
D fpathconf PR 10I 0 ExtProc('fpathconf')
D fildes 10I 0 Value
D name 10I 0 Value
*--------------------------------------------------------------------
* Get File Information by Descriptor
*
* int fstat(int fildes, struct stat *buf)
*--------------------------------------------------------------------
D fstat PR 10I 0 ExtProc('fstat')
D fildes 10I 0 Value
D buf likeds(statds)
*--------------------------------------------------------------------
* Get File Information by Descriptor, Large File Enabled
*
* int fstat64(int fildes, struct stat *buf)
*--------------------------------------------------------------------
D fstat64 PR 10I 0 ExtProc('fstat64')
D fildes 10I 0 Value
D buf likeds(statds64)
*--------------------------------------------------------------------
* fstatvfs() -- Get file system status by descriptor
*
* fildes = (input) file descriptor to use to locate file system
* buf = (output) data structure containing file system info
*
* Returns 0 if successful, -1 upon error.
* (error information is returned via the "errno" variable)
*--------------------------------------------------------------------
D fstatvfs PR 10I 0 ExtProc('fstatvfs64')
D fildes 10I 0 value
D buf like(ds_statvfs)
*--------------------------------------------------------------------
* Synchronize Changes to file
*
* int fsync(int fildes)
*--------------------------------------------------------------------
D fsync PR 10I 0 ExtProc('fsync')
D fildes 10I 0 Value
*--------------------------------------------------------------------
* Truncate file
*
* int ftruncate(int fildes, off_t length)
*--------------------------------------------------------------------
D ftruncate PR 10I 0 ExtProc('ftruncate')
D fildes 10I 0 Value
D length 10I 0 Value
*--------------------------------------------------------------------
* Truncate file, large file enabled
*
* int ftruncate64(int fildes, off64_t length)
*--------------------------------------------------------------------
D ftruncate64 PR 10I 0 ExtProc('ftruncate64')
D fildes 10I 0 Value
D length 20I 0 Value
*--------------------------------------------------------------------
* Get current working directory
*
* char *getcwd(char *buf, size_t size)
*--------------------------------------------------------------------
D getcwd PR * ExtProc('getcwd')
D buf * Value
D size 10U 0 Value
*--------------------------------------------------------------------
* Get effective group ID
*
* gid_t getegid(void)
*--------------------------------------------------------------------
D getegid PR 10U 0 ExtProc('getegid')
*--------------------------------------------------------------------
* Get effective user ID
*
* uid_t geteuid(void)
*--------------------------------------------------------------------
D geteuid PR 10U 0 ExtProc('geteuid')
*--------------------------------------------------------------------
* Get Real Group ID
*
* gid_t getgid(void)
*--------------------------------------------------------------------
D getgid PR 10U 0 ExtProc('getgid')
*--------------------------------------------------------------------
* Get group information from group ID
*
* struct group *getgrgid(gid_t gid)
*--------------------------------------------------------------------
D getgrgid PR * ExtProc('getgrgid')
D gid 10U 0 VALUE
*--------------------------------------------------------------------
* Get group info using group name
*
* struct group *getgrnam(const char *name)
*--------------------------------------------------------------------
D getgrnam PR * ExtProc('getgrnam')
D name * VALUE
*--------------------------------------------------------------------
* Get group IDs
*
* int getgroups(int gidsetsize, gid_t grouplist[])
*--------------------------------------------------------------------
D getgroups PR * ExtProc('getgroups')
D gidsetsize 10I 0 value
D grouplist 10U 0 dim(256) options(*varsize)
*--------------------------------------------------------------------
* Get user information by user-name
*
* (Don't let the name mislead you, this does not return the password,
* the user info database on unix systems is called "passwd",
* therefore, getting the user info is called "getpw")
*
* struct passwd *getpwnam(const char *name)
*--------------------------------------------------------------------
D getpwnam PR * ExtProc('getpwnam')
D name * Value options(*string)
*--------------------------------------------------------------------
* Get user information by user-id number
*
* (Don't let the name mislead you, this does not return the password,
* the user info database on unix systems is called "passwd",
* therefore, getting the user info is called "getpw")
*
* struct passwd *getpwuid(uid_t uid)
*--------------------------------------------------------------------
D getpwuid PR * extproc('getpwuid')
D uid 10U 0 Value
*--------------------------------------------------------------------
* Get Real User-ID
*
* uid_t getuid(void)
*--------------------------------------------------------------------
D getuid PR 10U 0 ExtProc('getuid')
*--------------------------------------------------------------------
* Perform I/O Control Request
*
* int ioctl(int fildes, unsigned long req, ...)
*--------------------------------------------------------------------
D ioctl PR 10I 0 ExtProc('ioctl')
D fildes 10I 0 Value
D req 10U 0 Value
D arg * Value
*--------------------------------------------------------------------
* Change Owner/Group of symbolic link
*
* int lchown(const char *path, uid_t owner, gid_t group)
*
* NOTE: for non-symlinks, this behaves identically to chown().
* for symlinks, this changes ownership of the link, whereas
* chown() changes ownership of the file the link points to.
*--------------------------------------------------------------------
D lchown PR 10I 0 ExtProc('lchown')
D path * Value options(*string)
D owner 10U 0 Value
D group 10U 0 Value
*--------------------------------------------------------------------
* Create Hard Link to File
*
* int link(const char *existing, const char *new)
*--------------------------------------------------------------------
D link PR 10I 0 ExtProc('link')
D existing * Value options(*string)
D new * Value options(*string)
*--------------------------------------------------------------------
* Set File Read/Write Offset
*
* off_t lseek(int fildes, off_t offset, int whence)
*--------------------------------------------------------------------
D lseek PR 10I 0 ExtProc('lseek')
D fildes 10I 0 value
D offset 10I 0 value
D whence 10I 0 value
*--------------------------------------------------------------------
* Set File Read/Write Offset, Large File Enabled
*
* off64_t lseek64(int fildes, off64_t offset, int whence)
*--------------------------------------------------------------------
D lseek64 PR 20I 0 ExtProc('lseek64')
D fildes 10I 0 value
D offset 20I 0 value
D whence 10I 0 value
*--------------------------------------------------------------------
* Get File or Link Information
*
* int lstat(const char *path, struct stat *buf)
*
* NOTE: for non-symlinks, this behaves identically to stat().
* for symlinks, this gets information about the link, whereas
* stat() gets information about the file the link points to.
*--------------------------------------------------------------------
D lstat PR 10I 0 ExtProc('lstat')
D path * Value options(*string)
D buf likeds(statds)
*--------------------------------------------------------------------
* Get File or Link Information, Large File Enabled
*
* int lstat64(const char *path, struct stat64 *buf)
*
* NOTE: for non-symlinks, this behaves identically to stat().
* for symlinks, this gets information about the link, whereas
* stat() gets information about the file the link points to.
*--------------------------------------------------------------------
D lstat64 PR 10I 0 ExtProc('lstat64')
D path * Value options(*string)
D buf likeds(statds64)
*--------------------------------------------------------------------
* Make Directory
*
* int mkdir(const char *path, mode_t mode)
*--------------------------------------------------------------------
D mkdir PR 10I 0 ExtProc('mkdir')
D path * Value options(*string)
D mode 10U 0 Value
*--------------------------------------------------------------------
* Make FIFO Special File
*
* int mkfifo(const char *path, mode_t mode)
*--------------------------------------------------------------------
/if defined(*V5R1M0)
D mkfifo PR 10I 0 ExtProc('mkfifo')
D path * Value options(*string)
D mode 10U 0 Value
/endif
*--------------------------------------------------------------------
* Open a File
*
* int open(const char *path, int oflag, . . .);
*--------------------------------------------------------------------
D open PR 10I 0 ExtProc('open')
D path * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D ccsid 10U 0 value options(*nopass)
D/if defined(*V5R2M0)
D txtcreatid 10U 0 value options(*nopass)
D/endif
*--------------------------------------------------------------------
* Open a File, Large File Enabled
*
* int open64(const char *path, int oflag, . . .);
*
* NOTE: This is identical to calling open(), except that the
* O_LARGEFILE flag is automatically supplied.
*--------------------------------------------------------------------
D open64 PR 10I 0 ExtProc('open64')
D filename * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D codepage 10U 0 value options(*nopass)
D/if defined(*V5R2M0)
D txtcreatid 10U 0 value options(*nopass)
D/endif
*--------------------------------------------------------------------
* Open a Directory
*
* DIR *opendir(const char *dirname)
*--------------------------------------------------------------------
D opendir PR * EXTPROC('opendir')
D dirname * VALUE options(*string)
*--------------------------------------------------------------------
* Get configurable path name variables
*
* long pathconf(const char *path, int name)
*--------------------------------------------------------------------
D pathconf PR 10I 0 ExtProc('pathconf')
D path * Value options(*string)
D name 10I 0 Value
*--------------------------------------------------------------------
* Create interprocess channel
*
* int pipe(int fildes[2]);
*--------------------------------------------------------------------
D pipe PR 10I 0 ExtProc('pipe')
D fildes 10I 0 dim(2)
*--------------------------------------------------------------------
* Read from Descriptor with Offset
*
* ssize_t pread(int filedes, void *buf, size_t nbyte, off_t offset);
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D pread PR 10I 0 ExtProc('pread')
D fildes 10I 0 value
D buf * value
D nbyte 10U 0 value
D offset 10I 0 value
/endif
*--------------------------------------------------------------------
* Read from Descriptor with Offset, Large File Enabled
*
* ssize_t pread64(int filedes, void *buf, size_t nbyte,
* size_t nbyte, off64_t offset);
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D pread64 PR 10I 0 ExtProc('pread64')
D fildes 10I 0 value
D buf * value
D nbyte 10U 0 value
D offset 20I 0 value
/endif
*--------------------------------------------------------------------
* Write to Descriptor with Offset
*
* ssize_t pwrite(int filedes, const void *buf,
* size_t nbyte, off_t offset);
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D pwrite PR 10I 0 ExtProc('pwrite')
D fildes 10I 0 value
D buf * value
D nbyte 10U 0 value
D offset 10I 0 value
/endif
*--------------------------------------------------------------------
* Write to Descriptor with Offset, Large File Enabled
*
* ssize_t pwrite64(int filedes, const void *buf,
* size_t nbyte, off64_t offset);
*--------------------------------------------------------------------
/if defined(*V5R2M0)
D pwrite64 PR 10I 0 ExtProc('pwrite64')
D fildes 10I 0 value
D buf * value
D nbyte 10U 0 value
D offset 20I 0 value
/endif
*--------------------------------------------------------------------
* Perform Miscellaneous file system functions
*--------------------------------------------------------------------
D QP0FPTOS PR ExtPgm('QP0FPTOS')
D Function 32A const
D Exten1 6A const options(*nopass)
D Exten2 3A const options(*nopass)
*--------------------------------------------------------------------
* Read From a File
*
* ssize_t read(int fildes, void *buffer, size_t bytes);
*--------------------------------------------------------------------
D read PR 10I 0 ExtProc('read')
D fildes 10i 0 value
D buf * value
D bytes 10U 0 value
*--------------------------------------------------------------------
* Read Directory Entry
*
* struct dirent *readdir(DIR *dirp)
*--------------------------------------------------------------------
D readdir PR * EXTPROC('readdir')
D dirp * VALUE
*--------------------------------------------------------------------
* Read Value of Symbolic Link
*
* int readlink(const char *path, char *buf, size_t bufsiz)
*--------------------------------------------------------------------
D readlink PR 10I 0 ExtProc('readlink')
D path * value options(*string)
D buf * value
D bufsiz 10U 0 value
*--------------------------------------------------------------------
* Read From Descriptor using Multiple Buffers
*
* int readv(int fildes, struct iovec *io_vector[], int vector_len);
*--------------------------------------------------------------------
D readv PR 10I 0 ExtProc('readv')
D fildes 10i 0 value
D io_vector like(iovec)
D dim(256) options(*varsize)
D vector_len 10I 0 value
*--------------------------------------------------------------------
* Rename File or Directory
*
* int rename(const char *old, const char *new)
*
* Note: By defailt, if a file with the new name already exists,
* rename will fail with an error. If you define
* RENAMEUNLINK and a file with the new name already exists
* it will be unlinked prior to renaming.
*--------------------------------------------------------------------
/if defined(RENAMEUNLINK)
D rename PR 10I 0 ExtProc('Qp0lRenameUnlink')
D old * Value options(*string)
D new * Value options(*string)
/else
D rename PR 10I 0 ExtProc('Qp0lRenameKeep')
D old * Value options(*string)
D new * Value options(*string)
/endif
*--------------------------------------------------------------------
* Reset Directory Stream to Beginning
*
* void rewinddir(DIR *dirp)
*--------------------------------------------------------------------
D rewinddir PR ExtProc('rewinddir')
D dirp * value
*--------------------------------------------------------------------
* Remove Directory
*
* int rmdir(const char *path)
*--------------------------------------------------------------------
D rmdir PR 10I 0 ExtProc('rmdir')
D path * value options(*string)
*--------------------------------------------------------------------
* Get File Information
*
* int stat(const char *path, struct stat *buf)
*--------------------------------------------------------------------
D stat PR 10I 0 ExtProc('stat')
D path * value options(*string)
D buf * value
*--------------------------------------------------------------------
* Get File Information, Large File Enabled
*
* int stat(const char *path, struct stat64 *buf)
*--------------------------------------------------------------------
D stat64 PR 10I 0 ExtProc('stat64')
D path * value options(*string)
D buf likeds(statds64)
*--------------------------------------------------------------------
* statvfs() -- Get file system status
*
* path = (input) pathname of a link ("file") in the IFS.
* buf = (output) data structure containing file system info
*
* Returns 0 if successful, -1 upon error.
* (error information is returned via the "errno" variable)
*--------------------------------------------------------------------
D statvfs PR 10I 0 ExtProc('statvfs64')
D path * value options(*string)
D buf like(ds_statvfs)
*--------------------------------------------------------------------
* Make Symbolic Link
*
* int symlink(const char *pname, const char *slink)
*--------------------------------------------------------------------
D symlink PR 10I 0 ExtProc('symlink')
D pname * value options(*string)
D slink * value options(*string)
*--------------------------------------------------------------------
* Get system configuration variables
*
* long sysconf(int name)
*--------------------------------------------------------------------
D sysconf PR 10I 0 ExtProc('sysconf')
D name 10I 0 Value
*--------------------------------------------------------------------
* Set Authorization Mask for Job
*
* mode_t umask(mode_t cmask)
*--------------------------------------------------------------------
D umask PR 10U 0 ExtProc('umask')
D cmask 10U 0 Value
*--------------------------------------------------------------------
* Remove Link to File. (Deletes Directory Entry for File, and if
* this was the last link to the file data, the file itself is
* also deleted)
*
* int unlink(const char *path)
*--------------------------------------------------------------------
D unlink PR 10I 0 ExtProc('unlink')
D path * Value options(*string)
*--------------------------------------------------------------------
* Set File Access & Modification Times
*
* int utime(const char *path, const struct utimbuf *times)
*--------------------------------------------------------------------
D utime PR 10I 0 ExtProc('utime')
D path * value options(*string)
D times likeds(utimbuf) options(*omit)
*--------------------------------------------------------------------
* Write to a file
*
* ssize_t write(int fildes, const void *buf, size_t bytes)
*--------------------------------------------------------------------
D write PR 10I 0 ExtProc('write')
D fildes 10i 0 value
D buf * value
D bytes 10U 0 value
*--------------------------------------------------------------------
* Write to a file using (with type A field in prototype)
*
* ssize_t write(int fildes, const void *buf, size_t bytes)
*--------------------------------------------------------------------
D writeA PR 10I 0 ExtProc('write')
D fildes 10i 0 value
D buf 65535A const options(*varsize)
D bytes 10U 0 value
*--------------------------------------------------------------------
* Write to descriptor using multiple buffers
*
* int writev(int fildes, struct iovec *iovector[], int vector_len);
*--------------------------------------------------------------------
D writev PR 10I 0 ExtProc('writev')
D fildes 10i 0 value
D io_vector like(iovec)
D dim(256) options(*varsize)
D vector_len 10I 0 value
json/json_h.rpgle 100666 241 0 20552 12003576722 11700 0 ustar 00IUSR0001 /if not defined (JSON)
/define JSON
/*
* Copyright (c) 2007-2012 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
*-------------------------------------------------------------------------
* Prototypes
*-------------------------------------------------------------------------
D json_create PR * extproc('json_create')
*
D json_dispose PR extproc('json_dispose')
D jsonPtr *
*
D json_remove PR extproc('json_remove') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_clear PR extproc('json_clear')
D jsonPtr * const
*
D json_getNext PR * extproc('json_getNext')
D jsonPtr * const
*
D json_abortIteration...
D PR extproc('json_abortIteration')
D jsonPtr * const
*
D json_contains...
D PR N extproc('json_contains') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_isEmpty PR N extproc('json_isEmpty')
D jsonPtr * const
*
D json_size PR 10I 0 extproc('json_size')
D jsonPtr * const
*
D json_putString PR extproc('json_putString') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 65535A const options(*varsize)
D valueLength 10I 0 const options(*nopass)
*
D json_putBoolean...
D PR extproc('json_putBoolean') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value N const
*
D json_putInt...
D PR extproc('json_putInt') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 10I 0 const
*
D json_putLong...
D PR extproc('json_putLong') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 20I 0 const
*
D json_putDouble...
D PR extproc('json_putDouble') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 8F const
*
D json_putArray...
D PR extproc('json_putArray') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D array * const
*
D json_get PR * extproc('json_get') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getString PR * extproc('json_getString') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getBoolean...
D PR N extproc('json_getBoolean') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getInt...
D PR 10I 0 extproc('json_getInt') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getLong...
D PR 20I 0 extproc('json_getLong') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getDouble...
D PR 8F extproc('json_getDouble') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getArray...
D PR * extproc('json_getArray') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_toString PR * extproc('json_toString')
D jsonPtr * const
D pOutputFormat...
D 10I 0 const options(*nopass)
D pPrettyPrintFormat...
D likeds(json_prettyPrintFormat)
D const options(*nopass)
D pIndentationLevel...
D 10I 0 options(*nopass)
*
D json_putNull PR extproc('json_putNull') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_putObject...
D PR extproc('json_putObject') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D objPtr * const
*
D json_getObject...
D PR * extproc('json_getObject') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_getEntryType...
D PR 10I 0 extproc('json_getEntryType') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D json_isNull...
D PR N extproc('json_isNull') opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*-------------------------------------------------------------------------
* Data structures
*-------------------------------------------------------------------------
D json_prettyPrintFormat...
D DS qualified based(template)
D useTabs N
D numberWhitespace...
D 5U 0
D breakAfterElement...
D N
D breakAfterObjectBrace...
D N
D breakBeforeArrayBrace...
D N
D breakAfterArrayBrace...
D N
*
* include the prototypes from the json array module
*
/copy 'json_arr_h.rpgle'
*
* include the prototypes from the json parser module
*
/copy 'json_par_h.rpgle'
*
* include the prototypes from the json checker module
*
/copy 'json_chk_h.rpgle'
*
* include the prototypes from the json checker utilities module
*
/copy 'json_cut_h.rpgle'
*
* include the prototypes from the json utilities module
*
/copy 'json_util_h.rpgle'
*
* include json constants
*
/copy 'json_c.rpgle'
/endif
json/json_par_h.rpgle 100666 241 0 2455 11612762573 12532 0 ustar 00IUSR0001 /if not defined (JSON_PAR)
/define JSON_PAR
/*
* Copyright (c) 2007-2009 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
*---------------------------------------------------------------
* Prototypes
*---------------------------------------------------------------
D json_parse PR * extproc('json_parse')
D json_string * const options(*omit)
D ptrHeader * const options(*nopass)
/endif
json/json_arr_h.rpgle 100666 241 0 14123 12003600061 12521 0 ustar 00IUSR0001 /if not defined (JSON_ARR)
/define JSON_ARR
/*
* Copyright (c) 2007-2012 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
*-------------------------------------------------------------------------
* Prototypes
*-------------------------------------------------------------------------
D jsona_create PR * extproc('jsona_create')
*
D jsona_dispose PR extproc('jsona_dispose')
D jsonArrPtr *
*
D jsona_remove PR extproc('jsona_remove') opdesc
D jsonArrPtr * const
D index 10I 0 const
*
D jsona_clear PR extproc('jsona_clear')
D jsonArrPtr * const
*
D jsona_putString...
D PR extproc('jsona_putString') opdesc
D jsonArrPtr * const
D value 65535A const options(*varsize)
D index 10U 0 const options(*nopass : *omit)
D valueLength 10I 0 const options(*nopass)
*
D jsona_putBoolean...
D PR extproc('jsona_putBoolean')
D jsonArrPtr * const
D value N const
D index 10U 0 const options(*nopass)
*
D jsona_putInt...
D PR extproc('jsona_putInt')
D jsonArrPtr * const
D value 10I 0 const
D index 10U 0 const options(*nopass)
*
D jsona_putLong...
D PR extproc('jsona_putLong')
D jsonArrPtr * const
D value 20I 0 const
D index 10U 0 const options(*nopass)
*
D jsona_putDouble...
D PR extproc('jsona_putDouble')
D jsonArrPtr * const
D value 8F const
D index 10U 0 const options(*nopass)
*
D jsona_putArray...
D PR extproc('jsona_putArray')
D jsonArrPtr * const
D value * const
D index 10U 0 const options(*nopass)
*
D jsona_getString...
D PR * extproc('jsona_getString')
D jsonArrPtr * const
D index 10U 0 const
*
D jsona_getBoolean...
D PR N extproc('jsona_getBoolean')
D jsonArrPtr * const
D index 10U 0 const
*
D jsona_getInt...
D PR 10I 0 extproc('jsona_getInt')
D jsonArrPtr * const
D index 10U 0 const
*
D jsona_getLong...
D PR 20I 0 extproc('jsona_getLong')
D jsonArrPtr * const
D index 10U 0 const
*
D jsona_getDouble...
D PR 8F extproc('jsona_getDouble')
D jsonArrPtr * const
D index 10U 0 const
*
D jsona_getArray...
D PR * extproc('jsona_getArray')
D jsonArrPtr * const
D index 10U 0 const
*
D jsona_toString...
D PR * extproc('jsona_toString')
D jsonArrPtr * const
D pOutputFormat...
D 10I 0 const options(*nopass)
D pPrettyPrintFormat...
D likeds(json_prettyPrintFormat)
D const options(*nopass)
D pIndentationLevel...
D 10I 0 options(*nopass)
*
D jsona_putNull PR extproc('jsona_putNull')
D jsonPtr * const
D index 10U 0 const options(*nopass)
*
D jsona_putObject...
D PR extproc('jsona_putObject')
D jsonPtr * const
D objPtr * const
D index 10U 0 const options(*nopass)
*
D jsona_getObject...
D PR * extproc('jsona_getObject')
D jsonPtr * const
D index 10U 0 const
*
D jsona_size PR 10U 0 extproc('jsona_size')
D jsonArrPtr * const
*
D jsona_getEntryType...
D PR 10I 0 extproc('jsona_getEntryType')
D jsonPtr * const
D index 10U 0 const
*
D jsona_isNull...
D PR N extproc('jsona_isNull')
D jsonArrPtr * const
D index 10U 0 const
/endif
json/iconv_h.rpgle 100666 241 0 4027 11612762575 12034 0 ustar 00IUSR0001 *---------------------------------------------------------------
* Data structures
*---------------------------------------------------------------
D iconv_t DS based(prototype_only) qualified
D return_value 10I 0
D cd 10I 0 dim(12)
*
D iconv_from DS qualified
D ccsid 10I 0 inz(0)
D convAlt 10I 0 inz(0)
D subsAlt 10I 0 inz(0)
D shiftAlt 10I 0 inz(1)
D inpLenOp 10I 0 inz(0)
D errorOpt 10I 0 inz(1)
D reserved 8A inz(*ALLx'00')
*
D iconv_to DS qualified
D ccsid 10I 0 inz(819)
D convAlt 10I 0 inz(0)
D subsAlt 10I 0 inz(0)
D shiftAlt 10I 0 inz(1)
D inpLenOp 10I 0 inz(0)
D errorOpt 10I 0 inz(1)
D reserved 8A inz(*ALLx'00')
*---------------------------------------------------------------
* Prototypes
*---------------------------------------------------------------
D iconv_open PR extproc('QtqIconvOpen')
D like(iconv_t)
D tocode like(iconv_to) const
D fromcode like(iconv_from) const
*
D iconv PR 10I 0 extproc('iconv')
D cd like(iconv_t) value
D inbuf *
D inbytesleft 10U 0
D outbuf *
D outbytesleft 10U 0
*
D iconv_close PR 10I 0 extproc('iconv_close')
D cd like(iconv_t) value
json/json_inz.ccp 100666 241 0 132 11612762575 11645 0 ustar 00IUSR0001 extern "C" { int json_srvpgm_init(void); }
static int dummyInitVar = json_srvpgm_init();
json/unicode_c.rpgle 100666 241 0 2411 11612762575 12332 0 ustar 00IUSR0001 /if not defined (UNICODE_CONSTANTS)
/define UNICODE_CONSTANTS
D UNICODE_SLASH...
D C u'002F'
D UNICODE_BACKSLASH...
D C u'005C'
D UNICODE_APOSTROPHE...
D C u'0027'
D UNICODE_DOUBLE_QUOTE...
D C u'0022'
D UNICODE_LEFT_CURLY_BRACE...
D C u'007B'
D UNICODE_RIGHT_CURLY_BRACE...
D C u'007D'
D UNICODE_LEFT_BRACKET...
D C u'005B'
D UNICODE_RIGHT_BRACKET...
D C u'005D'
D UNICODE_LEFT_BRACE...
D C u'0028'
D UNICODE_RIGHT_BRACE...
D C u'0029'
D UNICODE_COLON...
D C u'003A'
D UNICODE_SEMICOLON...
D C u'003B'
D UNICODE_COMMA...
D C u'002C'
D UNICODE_DOT...
D C u'002E'
D UNICODE_EQUAL...
D C u'003D'
/endif
json/json_int_h.rpgle 100666 241 0 12414 11612762575 12560 0 ustar 00IUSR0001 /*
* Copyright (c) 2007-2009 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
*------------------------------------------------------------------------
* Prototypes of internal procedures (shared among the modules)
*------------------------------------------------------------------------
D sendEscapeMessage...
D PR
D id 10I 0 const
*
D escapeLastToken...
D PR
D tokenList *
*
D sendDiagnosticMessage...
D PR
D message 200A const
*
D isJSONImpl...
D PR
D jsonPtr * const
*
D getJSONEntry PR *
D jsonPtr * const
D keyPtr * const
D keyLength 10U 0 const
*
D disposeEntryValue...
D PR
D entryPtr *
*
D prettyPrint PR
D tokenList * const
D printFormat const likeds(json_prettyPrintFormat)
D indentationLevel...
D 10I 0 const
*-------------------------------------------------------------------------
* Special Characters
*-------------------------------------------------------------------------
D tmpl_chars DS qualified based(nullPointer)
D d_quote 6A
D l_brace 6A
D r_brace 6A
D l_bracket 6A
D r_bracket 6A
D comma 6A
D colon 6A
D true 6A
D false 6A
D null_str 6A
D size_d_quote...
D 5I 0
D size_l_brace...
D 5I 0
D size_r_brace...
D 5I 0
D size_l_bracket...
D 5I 0
D size_r_bracket...
D 5I 0
D size_comma...
D 5I 0
D size_colon...
D 5I 0
D size_true...
D 5I 0
D size_false...
D 5I 0
D size_null_str...
D 5I 0
*-------------------------------------------------------------------------
* Data Structures
*-------------------------------------------------------------------------
/*
* If the json object has only one entry, the pointer for the firstand last
* entry points to the same entry. If the list has no entries both pointers
* has a *null value.
*
*
*
* The field iteration has the default value of -1. It means that no
* iteration is currently going on.
*
*/
D tmpl_header DS qualified based(template)
D id 20A
D size 10U 0
D firstEntry *
D lastEntry *
D iteration 10I 0
D iterNextEntry...
D *
D iterPrevEntry...
D *
D disposeList...
D *
*
D tmpl_entry DS qualified based(template)
D type 10I 0
D prev *
D next *
D key *
D keyLength 10U 0
D value *
D valueLength 10U 0
*
D tmpl_array_entry...
D DS qualified
D type 10I 0
D x 65531A
D string 65531A overlay(x)
D boolean N overlay(x)
D integer 10I 0 overlay(x)
D long 20I 0 overlay(x)
D double 8F overlay(x)
D object * overlay(x : 13)
D array * overlay(x : 13)
json/json_cut_h.rpgle 100666 241 0 3110 11612762575 12532 0 ustar 00IUSR0001 /if not defined (JSON_CUTIL)
/define JSON_CUTIL
/*
* Copyright (c) 2007-2009 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*/
*------------------------------------------------------------------------
* Prototypes
*------------------------------------------------------------------------
D json_validate PR N extproc('json_validate') opdesc
D json_string 65535A const options(*varsize)
D ccsid 10I 0 const options(*nopass)
*
D json_validateFile...
D PR N extproc('json_validateFile') opdesc
D path 65535A const options(*varsize)
D ccsid 10I 0 const options(*nopass)
/endif
json/ceeapi_h.rpgle 100666 241 0 16157 11612762575 12173 0 ustar 00IUSR0001 /if not defined (CEEAPI)
/define CEEAPI
*-------------------------------------------------------------------------
* ILE CEE API Prototypes
*-------------------------------------------------------------------------
D cee_getOpDescInfo...
D PR extproc('CEEDOD')
D position 10I 0 const
D descType 10I 0
D dataType 10I 0
D descInfo1 10I 0
D descInfo2 10I 0
D length 10I 0
D feedback 12A options(*omit)
*-------------------------------------------------------------------------
* Date API Prototypes
*-------------------------------------------------------------------------
D cee_getLilianDate...
D PR extproc('CEEDAYS') opdesc
D charDate 20A const options(*varsize)
D formatString 20A const options(*varsize)
D lilianDate 10I 0
D errorcode 100A options(*varsize : *nopass)
*
D cee_getDateFromLilian...
D PR extproc('CEEDATE') opdesc
D lilianDate 10I 0 const
D formatString 20A const options(*varsize)
D dateString 20A options(*varsize)
D errorcode 100A options(*varsize : *nopass)
*
* CEEDYWK returns the weekday as a number between 1 and 7
*
* 1 = Sonntag / Sunday
* 2 = Montag / Monday
* 3 = Dienstag / Tuesday
* 4 = Mittwoch / Wednesday
* 5 = Donnerstag / Thursday
* 6 = Freitag / Friday
* 7 = Samstag / Saturday
*
* 0 = Fehler bei der Berechnung / ungültiges Datum
*
D cee_getDayOfWeekNumeric...
D PR extproc('CEEDYWK') opdesc
D lilianDate 10I 0 const
D dayOfWeek 10I 0
D errorcode 100A options(*varsize : *nopass)
*
*-------------------------------------------------------------------------
* Memory Management API Prototypes
*-------------------------------------------------------------------------
* Interface to the CEEGTST API (Get Heap Storage).
* 1) HeapId = Id of the heap.
* 2) Size = Number of bytes to allocate
* 3) RetAddr= Return address of the allocated storage
* 4) *OMIT = The feedback parameter. Specifying *OMIT here
* means that we will receive an exception from
* the API if it cannot satisfy our request.
* Since we do not monitor for it, the calling
* procedure will receive the exception.
*-------------------------------------------------------------------------
D cee_getStorage...
D PR extproc('CEEGTST')
D heapId 10I 0 const
D size 10I 0 const
D retAddr *
D feedback 12A options(*omit)
*-------------------------------------------------------------------------
* Interface to the CEEFRST API (Free Storage).
* 1) Addr = Address of the allocated storage to be freed
* 2) *OMIT = The feedback parameter. Specifying *OMIT here
* means that we will receive an exception from
* the API if it cannot satisfy our request.
* Since we do not monitor for it, the calling
* procedure will receive the exception.
*-------------------------------------------------------------------------
D cee_freeStorage...
D PR extproc('CEEFRST')
D address *
D feedback 12A options(*omit)
*-------------------------------------------------------------------------
* Interface to the CEECZST API (Reallocate Storage).
* 1) Addr = Address of the allocated storage
* 2) Size = New size (number of bytes) of the allocated storage
* 3) *OMIT = The feedback parameter. Specifying *OMIT here
* means that we will receive an exception from
* the API if it cannot satisfy our request.
* Since we do not monitor for it, the calling
* procedure will receive the exception.
*-------------------------------------------------------------------------
D cee_reallocateStorage...
D PR extproc('CEECZST')
D address *
D size 10I 0 const
D feedback 12A options(*omit)
*-------------------------------------------------------------------------
* Interface to the CEECRHP API (Create Heap).
* 1) HeapId = Id of the heap.
* 2) InitSize = Initial size of the heap.
* 3) Incr = Number of bytes to increment if heap must be
* enlarged.
* 4) AllocStrat = Allocation strategy for this heap. We will
* specify a value of 0 which allows the system
* to choose the optimal strategy.
* 5) *OMIT = The feedback parameter. Specifying *OMIT here
* means that we will receive an exception from
* the API if it cannot satisfy our request.
* Since we do not monitor for it, the calling
* procedure will receive the exception.
*-------------------------------------------------------------------------
D cee_createHeap...
D PR extproc('CEECRHP')
D heapId 10I 0
D initSize 10I 0 const options(*omit)
D increment 10I 0 const options(*omit)
D allocStrat 10I 0 const options(*omit)
D feedback 12A options(*omit)
*-------------------------------------------------------------------------
* Interface to the CEEDSHP API (Discard Heap).
* 1) HeapId = Id of the heap.
* 2) *OMIT = The feedback parameter. Specifying *OMIT here
* means that we will receive an exception from
* the API if it cannot satisfy our request.
* Since we do not monitor for it, the calling
* procedure will receive the exception.
*-------------------------------------------------------------------------
D cee_discardHeap...
D PR extproc('CEEDSHP')
D heapId 10I 0
D feedback 12A options(*omit)
/endif
json/install 100666 241 0 2466 11612762575 10752 0 ustar 00IUSR0001 JSON Service Program Installation
These service program sources come as IFS files (not database file sources) and
with that has all the pros and cons of it.
The installation of this service program is really easy as it is accomplished
with the tool "make". The make tool is very much used in the Unix/Linux world.
To use it just type make in a QShell session (command qsh).
Requirements: You need a folder in the IFS for your global copy books (like /usr/local/include).
1. Download sources
2. FTP to IBM i server
3. It is a good idea to create a common source folder for IFS sources (mkdir /usr/local/src)
4. Extract sources (tar -xf json.tar)
5. Check the CCSID of the Makefile script with ls -S message
(it should have 437, 819, 850 or something like that. 37 won't work.
You can convert the file(s) with the conversion script,
see http://www.rpgnextgen.com/index.php?content=resources)
6. edit the Makefile to match your environment (mostly the BIN_LIB and INCLUDE variable),
use edtf or RDP or RPG Next Gen Editor
7. make
8. make install (to copy the prototypes to the include folder)
9. make clean (removes the rpg module and the binder source file)
FINISHED!
Now you got your service program installed.
If you got any questions just drop me a mail ( mihael at rpgnextgen.com ).
Mihael
json/llist_h.rpgle 100666 241 0 27506 11612762575 12074 0 ustar 00IUSR0001 /if not defined(LLIST)
/define LLIST
*------------------------------------------------------------------------
*
* Copyright (c) 2007-2009 Mihael Schmidt
* All rights reserved.
*
* This file is part of the LLIST service program.
*
* LLIST is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* LLIST is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with LLIST. If not, see http://www.gnu.org/licenses/.
*
*------------------------------------------------------------------------
*-------------------------------------------------------------------------
* Prototypes for Linked List
*-------------------------------------------------------------------------
D list_create PR * extproc('list_create')
*
D list_dispose PR extproc('list_dispose')
D listPtr *
*
D list_add PR N extproc('list_add')
D listPtr * const
D ptrValue * const
D length 10U 0 const
D pos 10U 0 const options(*nopass)
*
D list_addFirst PR N extproc('list_addFirst')
D listPtr *
D valuePtr * const
D length 10U 0 const
*
D list_addLast PR N extproc('list_addLast')
D listPtr * const
D valuePtr * const
D length 10U 0 const
*
D list_addAll PR N extproc('list_addAll')
D listPtr * const
D srcListPtr * const
*
D list_remove PR N extproc('list_remove')
D listPtr * const
D index 10U 0 const
*
D list_removeFirst...
D PR N extproc('list_removeFirst')
D listPtr * const
*
D list_removeLast...
D PR N extproc('list_removeLast')
D listPtr * const
*
D list_clear PR N extproc('list_clear')
D listPtr * const
*
D list_isEmpty PR N extproc('list_isEmpty')
D listPtr * const
*
D list_replace PR N extproc('list_replace')
D listPtr * const
D ptrValue * const
D lengthValue 10U 0 const
D index 10U 0 const
*
D list_get PR * extproc('list_get')
D listPtr * const
D index 10U 0 const
*
D list_getFirst PR * extproc('list_getFirst')
D listPtr * const
*
D list_getLast PR * extproc('list_getLast')
D listPtr * const
*
D list_getNext PR * extproc('list_getNext')
D listPtr * const
*
D list_getPrev PR * extproc('list_getPrev')
D listPtr * const
*
D list_abortIteration...
D PR extproc('list_abortIteration')
D listPtr * const
*
D list_contains PR N extproc('list_contains')
D listPtr * const
D valuePtr * const
D valueLength 10U 0 const
*
D list_indexOf PR 10I 0 extproc('list_indexOf')
D listPtr * const
D valuePtr * const
D valueLength 10U 0 const
*
D list_lastIndexOf...
D PR 10I 0 extproc('list_lastIndexOf')
D listPtr * const
D valuePtr * const
D valueLength 10U 0 const
*
D list_toCharArray...
D PR extproc('list_toCharArray')
D listPtr * const
D arrayPtr * const
D count 10U 0 const
D length 10U 0 const
*
D list_size PR 10U 0 extproc('list_size')
D listPtr * const
*
D list_sublist PR * extproc('list_sublist')
D listPtr * const
D startIndex 10U 0 const
D length 10U 0 const options(*nopass)
*
D list_rotate PR extproc('list_rotate')
D listPtr * const
D rotatePos 10I 0 const
*
D list_swap PR N extproc('list_swap')
D listPtr * const
D itemPos1 10U 0 const
D itemPos2 10U 0 const
*
D list_foreach...
D PR extproc('list_foreach')
D listPtr * const
D procPtr * const procptr
D userData * const
*
D list_toString PR 65535A varying extproc('list_toString')
D listPtr * const
D separator 1A const varying options(*omit:*nopass)
D enclosing 100A const varying options(*nopass)
D enclosingEnd 100A const varying options(*nopass)
*
D list_split PR * extproc('list_split') opdesc
D string 65535A const options(*varsize)
D separator 1A const options(*nopass)
*
D list_reverse PR extproc('list_reverse')
D listPtr * const
*
D list_copy PR * extproc('list_copy')
D listPtr * const
*
D list_frequency...
D PR 10U 0 extproc('list_frequency')
D listPtr * const
D valuePtr * const
D valueLength 10U 0 const
*
D list_addString...
D PR N extproc('list_addString') opdesc
D listPtr * const
D value 65535A const options(*varsize)
D index 10U 0 const options(*nopass)
*
D list_addInteger...
D PR N extproc('list_addInteger')
D listPtr * const
D value 10I 0 const
D index 10U 0 const options(*nopass)
*
D list_addLong...
D PR N extproc('list_addLong')
D listPtr * const
D value 20I 0 const
D index 10U 0 const options(*nopass)
*
D list_addShort...
D PR N extproc('list_addShort')
D listPtr * const
D value 5I 0 const
D index 10U 0 const options(*nopass)
*
D list_addFloat...
D PR N extproc('list_addFloat')
D listPtr * const
D value 4F const
D index 10U 0 const options(*nopass)
*
D list_addDouble...
D PR N extproc('list_addDouble')
D listPtr * const
D value 8F const
D index 10U 0 const options(*nopass)
*
D list_addBoolean...
D PR N extproc('list_addBoolean')
D listPtr * const
D value N const
D index 10U 0 const options(*nopass)
*
D list_addDecimal...
D PR N extproc('list_addDecimal')
D listPtr * const
D value 15P 5 const
D index 10U 0 const options(*nopass)
*
D list_addDate...
D PR N extproc('list_addDate')
D listPtr * const
D value D const
D index 10U 0 const options(*nopass)
*
D list_getString...
D PR 65535A extproc('list_getString')
D listPtr * const
D index 10U 0 const
*
D list_getInteger...
D PR 10I 0 extproc('list_getInteger')
D listPtr * const
D index 10U 0 const
*
D list_getShort...
D PR 5I 0 extproc('list_getShort')
D listPtr * const
D index 10U 0 const
*
D list_getLong...
D PR 20I 0 extproc('list_getLong')
D listPtr * const
D index 10U 0 const
*
D list_getFloat...
D PR 4F extproc('list_getFloat')
D listPtr * const
D index 10U 0 const
*
D list_getDouble...
D PR 8F extproc('list_getDouble')
D listPtr * const
D index 10U 0 const
*
D list_getBoolean...
D PR N extproc('list_getBoolean')
D listPtr * const
D index 10U 0 const
*
D list_getDecimal...
D PR 15P 5 extproc('list_getDecimal')
D listPtr * const
D index 10U 0 const
*
D list_getDate...
D PR D extproc('list_getDate')
D listPtr * const
D index 10U 0 const
*
D list_sort PR extproc('list_sort')
D listPtr * const
D sortAlgo * const procptr
*
D list_removeRange...
D PR extproc('list_removeRange')
D listPtr * const
D index 10U 0 const
D numberElements...
D 10U 0 const
*
D list_merge...
D PR extproc('list_merge')
D destList * const
D sourceList * const
/endif
json/json_inz.cpp 100666 241 0 132 11612762575 11662 0 ustar 00IUSR0001 extern "C" { int json_srvpgm_init(void); }
static int dummyInitVar = json_srvpgm_init();
json/lgpl-3.0.txt 100666 241 0 16725 11612762575 11401 0 ustar 00IUSR0001 GNU LESSER GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
*
* If the entry is not of type string or the entry is not a date string
* in *ISO format an escape message will be sent.
*
* \author Mihael Schmidt
* \date 01.08.2010
*
* \param Pointer to the JSON object
* \param Key
*
* \return Date
*/
P json_util_getDate...
P B export
D PI D opdesc
D json * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(json)
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S D
/free
isJSONImpl(json);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(json : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_STRING);
retVal = %date(%str(entry.value) : *ISO);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Add date entry
*
* Convenience procedure for adding a date string in *ISO format to the
* json object.
*
* \author Mihael Schmidt
* \date 2010-08-01
*
* \param Pointer to the JSON object
* \param Key
* \param Date
*/
P json_util_putDate...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value D const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D tmpValue S 10A
D keyLength S 10I 0
D hexnull S 1A inz(x'00')
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
tmpValue = %char(value : *ISO);
// check if key is already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue) + 1); // +1 for the null byte
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue) + 1); // +1 for the null byte
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
memcpy(newEntry.value : %addr(tmpValue) : %size(tmpValue));
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
memcpy(newEntry.value + %size(tmpValue) : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Get date entry
*
* A convenience procedure for getting a date from a string entry.
* The string must be in *ISO format (yyyy-mm-dd).
*
*
*
* If the entry is not of type string or the entry is not a date string
* in *ISO format an escape message will be sent.
*
* \author Mihael Schmidt
* \date 01.08.2010
*
* \param Pointer to the JSON array
* \param Index
*
* \return Date
*/
P jsona_util_getDate...
P B export
D PI D
D jsonArrPtr * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(jsonArrPtr : index);
if (ptr <> *null);
if (entry.type = JSON_TYPE_STRING);
return %date(%str(ptr + 4) : *ISO);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return %date(); // dummy => will never come to this point
/end-free
P E
/**
* \brief Add date entry
*
* Convenience procedure for adding a date string in *ISO format to the
* JSON array.
*
* \author Mihael Schmidt
* \date 01.08.2010
*
* \param Pointer to the JSON array
* \param Date
* \param Index (default: last)
*/
P jsona_util_putDate...
P B export
D PI
D jsonArrPtr * const
D value D const
D index 10U 0 const options(*nopass)
*
D entry DS likeds(tmpl_array_entry) inz
/free
entry.type = JSON_TYPE_STRING;
entry.string = %char(value : *ISO);
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(entry) : 10 + 4);
else;
arraylist_add(jsonArrPtr : %addr(entry) : 10 + 4 : index);
endif;
/end-free
P E
/**
* \brief Output JSON Object to stream file
*
* \param JSON Object
* \param Stream file path
* \param CCSID (optional)
* \param Delete if file exist (optional)
*
* \throws CPF9898 Error on opening file
*/
P json_util_toFile...
P B export
D PI
D json * const
D filePath 1024A const
D pCcsid 10I 0 const options(*nopass : *omit)
D pDeleteFile N const options(*nopass : *omit)
D pOutputFormat...
D 10I 0 const options(*nopass)
D pPrettyPrintFormat...
D likeds(json_prettyPrintFormat)
D const options(*nopass)
*
D outputFormat S 10I 0
D prettyPrintOption...
D S N inz(*off)
D prettyPrintFormat...
D DS likeds(json_prettyPrintFormat) inz
D ccsid S 10I 0 inz(0)
D deleteFile S N inz(*off)
D jsonString S *
D fileHandle S 10I 0
D flags S 10I 0
D mode S 10I 0
D errorNumber S 10I 0 based(errorPtr)
D errorString S 1024A varying
D msgdata S 512A
D msgkey S 4A
/free
if (%parms() >= 3 and %addr(pCcsid) <> *null);
ccsid = pCcsid;
endif;
if (%parms() >= 4 and %addr(pDeleteFile) <> *null);
deleteFile = pDeleteFile;
endif;
if (%parms() >= 5);
outputFormat = pOutputFormat;
prettyPrintFormat.useTabs = *off;
prettyPrintFormat.numberWhitespace = 4;
prettyPrintFormat.breakAfterElement = *on;
prettyPrintFormat.breakAfterObjectBrace = *on;
prettyPrintFormat.breakBeforeArrayBrace = *on;
prettyPrintFormat.breakAfterArrayBrace = *on;
endif;
if (%parms() >= 6);
prettyPrintFormat = pPrettyPrintFormat;
endif;
if (outputFormat = JSON_OUTPUT_PRETTY_PRINT);
prettyPrintOption = *on;
endif;
if (deleteFile);
if (access(%trimr(filePath) : F_OK) >= 0);
// file exists => delete
system('RMVLNK OBJLNK(''' + %trimr(filePath) + ''')');
endif;
endif;
// create file
flags = O_WRONLY + O_CREAT + O_APPEND + O_TEXTDATA +
O_CCSID + O_TEXT_CREAT;
mode = S_IRUSR + S_IWUSR + S_IRGRP + S_IROTH;
fileHandle = open(%trimr(filePath) : flags : mode : ccsid : 0);
if (fileHandle < 0);
// could not create file
errorPtr = errno();
errorString = 'I/O Error: ' + %str(strerr(errorNumber));
msgdata = 'Could not create file ' + %trimr(filePath) +
': ' + errorString;
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
endif;
jsonString = json_toString(json : outputFormat : prettyPrintFormat);
callp write(fileHandle : jsonString : strlen(jsonString));
callp close(fileHandle);
/end-free
P E
/**
* \brief Read JSON from stream file
*
* \param Stream file path
* \param Delete file after reading (optional)
*
* \return JSON object
*
* \throws CPF9898 Error on reading file
* \throws CPF9898 File not found
* \throws CPF9898 Error buildng JSON object
*/
P json_util_fromFile...
P B export
D PI *
D filePath 1024A const
D pDeleteFile N const options(*nopass)
*
D json S *
D deleteFile S N inz(*off)
D buffer S *
D fileSize S 10I 0
D fileStatus DS likeds(statds)
D fileHandle S 10I 0
D flags S 10I 0
D errorNumber S 10I 0 based(errorPtr)
D errorString S 1024A varying
D msgdata S 512A
D msgkey S 4A
/free
if (%parms() = 2);
deleteFile = pDeleteFile;
endif;
if (stat(%trimr(filePath) : %addr(fileStatus)) < 0);
msgdata = 'Could not query file attributes for file ' +
%trimr(filepath) + '.';
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
endif;
flags = O_RDONLY + O_TEXTDATA;
fileHandle = open(%trimr(filePath) : flags);
if (fileHandle < 0);
// could not open file
errorPtr = errno();
errorString = 'I/O Error: ' + %str(strerr(errorNumber));
msgdata = 'Could not open file ' + %trimr(filePath) + ': '+errorString;
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
endif;
buffer = %alloc(fileStatus.st_size);
callp read(fileHandle : buffer : fileStatus.st_size);
callp close(fileHandle);
json = json_parse(buffer);
// clean up
dealloc buffer;
if (deleteFile);
if (access(%trimr(filePath) : F_OK) >= 0);
// file exists => delete
system('RMVLNK OBJLNK(''' + %trimr(filePath) + ''')');
endif;
endif;
return json;
/end-free
P E
/**
* \brief Get decimal entry
*
* A convenience procedure for getting a decimal value from a string entry.
*
*
*
* If the entry is not of type string or the entry is not a number
* an escape message will be sent.
*
* \author Mihael Schmidt
* \date 09.04.2011
*
* \param Pointer to the JSON object
* \param Key
*
* \return Decimal value
*/
P json_util_getDecimal...
P B export
D PI 30P10 opdesc
D json * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(json)
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S 30P10
/free
isJSONImpl(json);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(json : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_STRING);
retVal = %dec(%str(entry.value) : 30 : 10);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get decimal entry
*
* A convenience procedure for getting a decimal value from a string entry.
*
*
*
* If the entry is not of type string or the entry is not a number
* an escape message will be sent.
*
* \author Mihael Schmidt
* \date 09.04.2011
*
* \param Pointer to the JSON array
* \param Index
*
* \return Decimal value
*/
P jsona_util_getDecimal...
P B export
D PI 30P10
D jsonArrPtr * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
D retVal S 30P10
/free
ptr = arraylist_get(jsonArrPtr : index);
if (ptr <> *null);
if (entry.type = JSON_TYPE_STRING);
retVal = %dec(%str(ptr + 4) : 30 : 10);
return retVal;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return 0; // dummy => will never come to this point
/end-free
P E
/**
* \brief Add decimal entry
*
* Convenience procedure for adding a decimal value as a string to the
* json object.
*
* \author Mihael Schmidt
* \date 09.04.2011
*
* \param Pointer to the JSON object
* \param Key
* \param Decimal value
* \param Decimal positions (default: 2)
*/
P json_util_putDecimal...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 30P10 const
D pDecimalPositions...
D 2P 0 const options(*nopass)
*
D decimalPositions...
D S 2P 0 inz(2)
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D tmpValue S 32A
D tmpValueLength S 10I 0
D keyLength S 10I 0
D hexnull S 1A inz(x'00')
D decimalSepIndex...
D S 10I 0
/free
isJSONImpl(jsonPtr);
if (%parms() = 4);
decimalPositions = pDecimalPositions;
endif;
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
tmpValue = %char(value);
// max. decimal precision of 10
if (decimalPositions > 10);
decimalPositions = 10;
elseif (decimalPositions < 0); // min. decimal precision of 0
decimalPositions = 0;
endif;
// limit the string to the passed number of decimal positions
decimalSepIndex = %scan('.' : tmpValue);
if (decimalSepIndex = 0);
decimalSepIndex = %scan(',' : tmpValue);
endif;
if (decimalSepIndex <> 0);
tmpValueLength = decimalSepIndex + decimalPositions;
else;
tmpValueLength = %len(%trim(tmpvalue));
endif;
// check if key is already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = tmpValueLength;
newEntry.value = %alloc(tmpValueLength + 1); // +1 for the null byte
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = tmpValueLength;
newEntry.value = %alloc(tmpValueLength + 1); // +1 for the null byte
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
memcpy(newEntry.value : %addr(tmpValue) : tmpValueLength);
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
memcpy(newEntry.value + tmpValueLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add decimal entry
*
* Convenience procedure for adding a decimal value as a string to the
* JSON array.
*
* \author Mihael Schmidt
* \date 12.04.2011
*
* \param Pointer to the JSON array
* \param Decimal value
* \param Decimal positions (default: 2)
* \param Index (default: last)
*/
P jsona_util_putDecimal...
P B export
D PI
D jsonArrPtr * const
D value 30P10 const
D pDecimalPositions...
D 2P 0 const options(*nopass : *omit)
D index 10U 0 const options(*nopass)
*
D entry DS likeds(tmpl_array_entry) inz
D decimalSepIndex...
D S 10I 0
D decimalPositions...
D S 2P 0 inz(2)
D tmpValueLength S 10I 0
/free
entry.type = JSON_TYPE_STRING;
entry.string = %char(value);
if (%parms() >= 3 and %addr(pDecimalPositions) <> *null);
decimalPositions = pDecimalPositions;
endif;
// max. decimal precision of 10
if (decimalPositions > 10);
decimalPositions = 10;
elseif (decimalPositions < 0); // min. decimal precision of 0
decimalPositions = 0;
endif;
// limit the string to the passed number of decimal positions
decimalSepIndex = %scan('.' : entry.string);
if (decimalSepIndex = 0);
decimalSepIndex = %scan(',' : entry.string);
endif;
if (decimalSepIndex <> 0);
tmpValueLength = decimalSepIndex + decimalPositions;
else;
tmpValueLength = %len(%trim(entry.string));
endif;
if (%parms() < 4);
arraylist_add(jsonArrPtr : %addr(entry) : tmpValueLength + 4);
else;
arraylist_add(jsonArrPtr : %addr(entry) : tmpValueLength + 4 : index);
endif;
/end-free
P E
/**
* \brief Get time entry
*
* A convenience procedure for get a time from a string entry.
* The string must be in *ISO format (hh.mm.ss).
*
*
*
* If the entry is not of type string or the entry is not a time string
* in *ISO format an escape message will be send.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON object
* \param Key
*
* \return Time
*/
P json_util_getTime...
P B export
D PI T opdesc
D json * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(json)
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S T
/free
isJSONImpl(json);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(json : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_STRING);
retVal = %time(%str(entry.value) : *ISO);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Add time entry
*
* Convenience procedure for adding a time string in *ISO format to the
* json object.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON object
* \param Key
* \param Time
*/
P json_util_putTime...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value T const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D tmpValue S 8A
D keyLength S 10I 0
D hexnull S 1A inz(x'00')
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
tmpValue = %char(value : *ISO);
// check if key is already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue) + 1); // +1 for the null byte
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue) + 1); // +1 for the null byte
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
memcpy(newEntry.value : %addr(tmpValue) : %size(tmpValue));
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
memcpy(newEntry.value + %size(tmpValue) : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Get time entry
*
* A convenience procedure for get a time from a string entry.
* The string must be in *ISO format (hh.mm.ss).
*
*
*
* If the entry is not of type string or the entry is not a time string
* in *ISO format an escape message will be send.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON array
* \param Index
*
* \return Time
*/
P jsona_util_getTime...
P B export
D PI T
D jsonArrPtr * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(jsonArrPtr : index);
if (ptr <> *null);
if (entry.type = JSON_TYPE_STRING);
return %time(%str(ptr + 4) : *ISO);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return %time(); // dummy => will never come to this point
/end-free
P E
/**
* \brief Add time entry
*
* Convenience procedure for adding a time string in *ISO format to the
* JSON array.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON array
* \param Time
* \param Index (default: last)
*/
P jsona_util_putTime...
P B export
D PI
D jsonArrPtr * const
D value T const
D index 10U 0 const options(*nopass)
*
D entry DS likeds(tmpl_array_entry) inz
/free
entry.type = JSON_TYPE_STRING;
entry.string = %char(value : *ISO);
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(entry) : 8 + 4);
else;
arraylist_add(jsonArrPtr : %addr(entry) : 8 + 4 : index);
endif;
/end-free
P E
/**
* \brief Get timestamp entry
*
* A convenience procedure for get a timestamp from a string entry.
* The string must be in *ISO format (yyyy-mm-dd-hh.mm.ss.mmmmmm).
*
*
*
* If the entry is not of type string or the entry is not a timestamp string
* in *ISO format an escape message will be send.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON object
* \param Key
*
* \return Timestamp
*/
P json_util_getTimestamp...
P B export
D PI Z opdesc
D json * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(json)
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S Z
/free
isJSONImpl(json);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(json : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_STRING);
retVal = %timestamp(%str(entry.value) : *ISO);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Add timestamp entry
*
* Convenience procedure for adding a timestamp string in *ISO format to the
* json object.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON object
* \param Key
* \param Timestamp
*/
P json_util_putTimestamp...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value Z const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D tmpValue S 26A
D keyLength S 10I 0
D hexnull S 1A inz(x'00')
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
tmpValue = %char(value : *ISO);
// check if key is already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue) + 1); // +1 for the null byte
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue) + 1); // +1 for the null byte
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
memcpy(newEntry.value : %addr(tmpValue) : %size(tmpValue));
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
memcpy(newEntry.value + %size(tmpValue) : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Get timestamp entry
*
* A convenience procedure for get a timestamp from a string entry.
* The string must be in *ISO format (yyyy-mm-dd-hh.mm.ss.mmmmmm).
*
*
*
* If the entry is not of type string or the entry is not a timestamp string
* in *ISO format an escape message will be send.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON array
* \param Index
*
* \return Timestamp
*/
P jsona_util_getTimestamp...
P B export
D PI Z
D jsonArrPtr * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(jsonArrPtr : index);
if (ptr <> *null);
if (entry.type = JSON_TYPE_STRING);
return %timestamp(%str(ptr + 4) : *ISO);
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return %timestamp(); // dummy => will never come to this point
/end-free
P E
/**
* \brief Add timestamp entry
*
* Convenience procedure for adding a timestamp string in *ISO format to the
* JSON array.
*
* \author Brian Garland
* \date 2011-06-24
*
* \param Pointer to the JSON array
* \param Timestamp
* \param Index (default: last)
*/
P jsona_util_putTimestamp...
P B export
D PI
D jsonArrPtr * const
D value Z const
D index 10U 0 const options(*nopass)
*
D entry DS likeds(tmpl_array_entry) inz
/free
entry.type = JSON_TYPE_STRING;
entry.string = %char(value : *ISO);
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(entry) : 26 + 4);
else;
arraylist_add(jsonArrPtr : %addr(entry) : 26 + 4 : index);
endif;
/end-free
P E
/**
* \brief Convert a data structure to a JSON object
*
* \param Data structure
* \param Qualified file name that the data structure is based upon
* (10A filename + 10A library)
*
* \return JSON object
*
* \throws CPF9898 File not found
* \throws CPF9898 Error building JSON object
*
* \info Varying fields with a 4-byte header are not supported.
*
* \author Brian Garland
*/
P json_util_dsToJsonObject...
P B export
D PI *
D dataStructure...
D 65535A options(*varsize)
D qFile 20A const
*
* Used to overlay some field types that either the API's don't support
* or it is just more convenient.
*
D fieldDS DS based(p_FieldDS) qualified
D integer 9B 0 overlay(fieldDS:1)
D smallInt 4B 0 overlay(fieldDS:1)
D bigInt 20I 0 overlay(fieldDS:1)
D float 4F overlay(fieldDS:1)
D date 10D overlay(fieldDS:1)
D time 8T overlay(fieldDS:1)
D timestamp 26Z overlay(fieldDS:1)
D real 4F overlay(fieldDS:1)
D double 8F overlay(fieldDS:1)
*
D buffer S 1A based(p_Buffer)
D bufferSize S 10I 0
D data S 30A
D fieldName S 50A
D i S 10I 0
D json S *
D msgdata S 512A
D msgkey S 4A
D nbrInt S 10I 0
D nbrDouble S 8F
D nbrLong S 20I 0
D rtnFile S 20A
D varCharLen S 5I 0 BASED(p_varCharLen)
/free
// Allocate just enough memory to find out how much we really need
p_Buffer = %ALLOC(8);
clear QUSEC;
QUSBPRV = %SIZE(QUSEC);
RetreiveFileDescription(buffer :
8 :
rtnFile :
'FILD0200' :
qFile :
'*FIRST' :
'0' :
'*LCL' :
'*EXT' :
QUSEC);
if QUSBAVL > 0;
// could not open file
msgdata = 'Error retreiving file description for ' +
%trimr(%subst(qFile:11:10)) + '/' +
%trimr(%subst(qFile:1:10)) + '. (' + QUSEI + ')';
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
endif;
// The API tells us how much memory we really need
p_Qddfmt = p_Buffer;
bufferSize = Qddbyava;
// Now allocate the correct amount of memory and call again
p_Buffer = %REALLOC(p_Buffer:bufferSize);
clear QUSEC;
QUSBPRV = %SIZE(QUSEC);
RetreiveFileDescription(buffer :
bufferSize :
rtnFile :
'FILD0200' :
qFile :
'*FIRST' :
'0' :
'*LCL' :
'*EXT' :
QUSEC);
if QUSBAVL > 0;
// could not open file
msgdata = 'Error retreiving file description for ' +
%trimr(%subst(qFile:11:10)) + '/' +
%trimr(%subst(qFile:1:10)) + '. (' + QUSEI + ')';
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
endif;
json = json_Create();
// Point to the Format Definition Header
p_Qddfmt = p_Buffer;
// Point to the first Field Header
p_Qddffld = p_Qddfmt + %size(Qddfmt);
for i = 1 to Qddffldnum;
// Point to Alias Name Entry
p_Qddfalis = p_Qddffld + Qddfxals;
// Determine field name to use as JSON "name"
// Qddffldi = field name aka: short name
// Qddfalsn = alias name (length = Qddfalsl) aka: long name
if Qddfalsl = 0;
fieldName = Qddffldi;
else;
fieldName = %subst(Qddfalsn:1:Qddfalsl);
endif;
// Retreive actual data to use as JSON "value"
// Qddfftyp = field type (see constants)
// Qddffibo = offset to field
// Qddffldb = field length
// Qddffldd = number of digits (for numeric)
// Qddffldp = decimal positions (for numeric)
select;
when Qddfftyp = FIELD_TYPE_BINARY; // either 5I0, 10I0, or 20I0
p_FieldDS = %ADDR(dataStructure)+Qddffibo;
if Qddffldb = 2;
json_putInt(json:%TRIMR(fieldName):fieldDS.smallInt);
elseif Qddffldb = 4;
json_putInt(json:%TRIMR(fieldName):fieldDS.integer);
elseif Qddffldb = 8;
json_putLong(json:%TRIMR(fieldName):fieldDS.bigInt);
endif;
when Qddfftyp = FIELD_TYPE_FLOAT; // either 4F or 8F
p_FieldDS = %ADDR(dataStructure)+Qddffibo;
if Qddffldb = 4;
json_putDouble(json:%TRIMR(fieldName):fieldDS.Float);
elseif Qddffldb = 8;
json_putDouble(json:%TRIMR(fieldName):fieldDS.Double);
endif;
when Qddfftyp = FIELD_TYPE_ZONED; // signed (S) type of any supported size
data = ExtractNumber(%ADDR(dataStructure)+Qddffibo:
'L':'*ZONED':Qddffldd:Qddffldp);
if qddffldp = 0;
// If no decimal places, treat like an integer
if qddffldd > 9;
nbrLong = %INT(%TRIMR(data));
json_putLong(json:%TRIMR(fieldName):nbrLong);
else;
nbrInt = %INT(%TRIMR(data));
json_putInt(json:%TRIMR(fieldName):nbrInt);
endif;
else;
// If decimal places, treat like a float
nbrDouble = %FLOAT(%TRIMR(data));
json_putDouble(json:%TRIMR(fieldName):nbrDouble);
endif;
when Qddfftyp = FIELD_TYPE_PACKED; // packed (P) type of any supported size
data = ExtractNumber(%ADDR(dataStructure)+Qddffibo:
'L':'*PACKED':Qddffldd:Qddffldp);
if qddffldp = 0;
// If no decimal places, treat like an integer
if qddffldd > 9;
nbrLong = %INT(%TRIMR(data));
json_putLong(json:%TRIMR(fieldName):nbrLong);
else;
nbrInt = %INT(%TRIMR(data));
json_putInt(json:%TRIMR(fieldName):nbrInt);
endif;
else;
// If decimal places, treat like a float
nbrDouble = %FLOAT(%TRIMR(data));
json_putDouble(json:%TRIMR(fieldName):nbrDouble);
endif;
when Qddfftyp = FIELD_TYPE_CHAR; // character (A) of any supported size
json_putString(json:%TRIMR(fieldName):
%TRIMR(%SUBST(dataStructure:Qddffibo+1:Qddffldb)));
when Qddfftyp = FIELD_TYPE_VARCHAR; // varying char (A) of any supported size
// Assumes 2 byte length at from of varying field
// I know IBM added longer fields that can have 4 byte length
// I don't know how to tell the difference though
p_varCharLen = %ADDR(dataStructure)+Qddffibo;
json_putString(json:%TRIMR(fieldName):
%TRIMR(%SUBST(dataStructure:Qddffibo+3:varCharLen)));
when Qddfftyp = FIELD_TYPE_DATE; // date (L) type
p_FieldDS = %ADDR(dataStructure)+Qddffibo;
json_util_putDate(json:%TRIMR(fieldName):fieldDS.Date);
when Qddfftyp = FIELD_TYPE_TIME; // time (T) type
p_FieldDS = %ADDR(dataStructure)+Qddffibo;
json_util_putTime(json:%TRIMR(fieldName):fieldDS.Time);
when Qddfftyp = FIELD_TYPE_TIMESTAMP; // timestamp (Z) type
p_FieldDS = %ADDR(dataStructure)+Qddffibo;
json_util_putTimestamp(json:%TRIMR(fieldName):fieldDS.Timestamp);
other;
// Unknown type?!?
endsl;
// Point to next Field Header
p_Qddffld = p_Qddffld + Qddfdefl;
endfor;
// Free up space
dealloc p_Buffer;
return json;
/end-free
P E
/**
* \brief Convert record data to an edited number.
*
* This makes it easy to extract zoned and packed fields from
* a substring of a record.
*
* \param Field pointer
* \param Edit code
* \param Field type (*ZONED or *PACKED)
* \param Number of digits
* \param Number of decimal places
*
* \return String containing edited value
*
* \author Brian Garland
*
* \throws CPF9898 File not found
* \throws CPF9898 Error building JSON object
*/
P extractNumber B
D PI 256A
D fieldPtr * value
D editCode 1A value
D fieldType 10A value
D numDigits 2P 0 value
D numDecimals 2P 0 value
D editMask S 256A
D editMaskLen S 10I 0
D outputLen S 10I 0
D zeroFillChar S 1A
D returnValue S 256A
D inputField S 31A BASED(fieldPtr)
/free
clear returnValue;
// Invoke the convert edit code API
clear QUSEC;
QUSBPRV = %SIZE(QUSEC);
ConvertEditCode(editMask :
editMaskLen :
outputLen :
zeroFillChar:
editCode :
' ' :
numDigits :
numDecimals :
QUSEC);
if QUSBAVL > 0;
return *blanks;
endif;
// Invoke the Edit API
clear QUSEC;
QUSBPRV = %SIZE(QUSEC);
Edit(returnValue :
outputLen :
inputField :
fieldType :
numDigits :
editMask :
editMaskLen :
zeroFillChar :
QUSEC);
if QUSBAVL > 0;
return *blanks;
endif;
return returnValue;
/end-free
P E
json/json_arr.rpgle 0000666 0001750 0001750 00000107206 12005141135 014675 0 ustar 00fist fist 0000000 0000000 /**
* \brief JSON Array Implementation
*
* The value of a JSON object can be an array. This service program deals
* with such arrays. Arrays themselves can also contain arrays. An array
* can only contain values and arrays but no key/value pairs.
*
*
*
* Throughout this service program is the index always 0-based. Which
* means that the first entry has the index 0, the second entry has the
* index 1 and so on.
*
*
*
* If the index is out of the bounds of the array an escape message will
* be send. If a procedure for the retrieval of a special type of value
* is called on an entry of another type an escape message will be send
* too.
*
* \author Mihael Schmidt
* \date 19.04.2008
*
* \link http://www.json.org JSON
* \link http://www.rpgnextgen.com RPG Next Gen
*
* \rev 07.03.2009 Mihael Schmidt
* Added jsona_size procedure.
*
* \rev 27.01.2010 Mihael Schmidt
* Added support for getting numbers with procedures jsona_getInt,
* jsona_getLong, jsona_getDouble no matter what the original type was
* (f. e. double value will be cast to int with jsona_getInt).
*
* \rev 09.04.2011 Mihael Schmidt
* Fixed memory management error in toString procedure.
*
* \rev 30.04.2011 Mihael Schmidt
* Switch from Linked List to ArrayList
*
* \rev 20.07.2011 Mihael Schmidt
* Remove leading plus (+) from floating point numbers when creating
* a string from a json array.
*
* \rev 23.07.2011 Mihael Schmidt
* Added jsona_isNull
*
* \rev 13.09.2011 Mihael Schmidt
* Bugfix: toString on empty array caused runtime error
*
* \rev 24.07.2012 Hugo Cantor
* Bugfix: jsona_putString : wrong parameter value length from CEEDOD
* added new parm for length
*/
*-------------------------------------------------------------------------
* Copyright (c) 2007-2012 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*-------------------------------------------------------------------------
H nomain
H bnddir('QC2LE')
H copyright('Copyright (c) 2007-2012 Mihael Schmidt. All rights reserved.')
*-------------------------------------------------------------------------
* Prototypes
*-------------------------------------------------------------------------
D jsona_srvpgm_init...
D PR 10I 0 extproc('jsona_srvpgm_init')
*
/copy 'json_h.rpgle'
/copy 'json_int_h.rpgle'
/copy 'ceeapi_h.rpgle'
/copy 'libc_h.rpgle'
/copy 'arraylist_h.rpgle'
*-------------------------------------------------------------------------
* Constants
*-------------------------------------------------------------------------
/copy 'json_c.rpgle'
/copy 'unicode_c.rpgle'
*-------------------------------------------------------------------------
* Global Variables
*-------------------------------------------------------------------------
D hex_null S 1A inz(x'00')
*
* Parameters passed to CEEDOD
*
D descType S 10I 0
D dataType S 10I 0
D descInfo1 S 10I 0
D descInfo2 S 10I 0
D length S 10I 0
*
D chars DS likeds(tmpl_chars)
D chars_compact DS likeds(tmpl_chars)
*-------------------------------------------------------------------------
* Procedures
*-------------------------------------------------------------------------
/**
* \brief Service program initialization
*
* String formattings are preloaded.
*/
P jsona_srvpgm_init...
P B export
D PI 10I 0
/free
chars.d_quote = %char(UNICODE_DOUBLE_QUOTE) + x'00';
chars.l_brace = ' ' + %char(UNICODE_LEFT_CURLY_BRACE) + ' ' + x'00';
chars.r_brace = ' ' + %char(UNICODE_RIGHT_CURLY_BRACE) + ' ' + x'00';
chars.l_bracket = ' ' + %char(UNICODE_LEFT_BRACKET) + ' ' + x'00';
chars.r_bracket = ' ' + %char(UNICODE_RIGHT_BRACKET) + ' ' + x'00';
chars.comma = ' ' + %char(UNICODE_COMMA) + ' ' + x'00';
chars.colon = ' ' + %char(UNICODE_COLON) + ' ' + x'00';
chars.true = 'true' + x'00';
chars.false = 'false' + x'00';
chars.null_str = 'null' + x'00';
chars.size_d_quote = 1;
chars.size_l_brace = 3;
chars.size_r_brace = 3;
chars.size_l_bracket = 3;
chars.size_r_bracket = 3;
chars.size_comma = 3;
chars.size_colon = 3;
chars.size_true = 4;
chars.size_false = 5;
chars.size_null_str = 4;
chars_compact.d_quote = %char(UNICODE_DOUBLE_QUOTE) + x'00';
chars_compact.l_brace = %char(UNICODE_LEFT_CURLY_BRACE) + x'00';
chars_compact.r_brace = %char(UNICODE_RIGHT_CURLY_BRACE) + x'00';
chars_compact.l_bracket = %char(UNICODE_LEFT_BRACKET) + x'00';
chars_compact.r_bracket = %char(UNICODE_RIGHT_BRACKET) + x'00';
chars_compact.comma = %char(UNICODE_COMMA) + x'00';
chars_compact.colon = %char(UNICODE_COLON) + x'00';
chars_compact.true = 'true' + x'00';
chars_compact.false = 'false' + x'00';
chars_compact.null_str = 'null' + x'00';
chars_compact.size_d_quote = 1;
chars_compact.size_l_brace = 1;
chars_compact.size_r_brace = 1;
chars_compact.size_l_bracket = 1;
chars_compact.size_r_bracket = 1;
chars_compact.size_comma = 1;
chars_compact.size_colon = 1;
chars_compact.size_true = 4;
chars_compact.size_false = 5;
chars_compact.size_null_str = 4;
return 0;
/end-free
P E
/**
* \brief Create JSON array
*
* Creates a json array "object". Currently a linked list is used
* as a backend for the json array.
*
* \author Mihael Schmidt
* \date 19.04.2008
*
* \return Pointer to the JSON array
*/
P jsona_create B export
D PI *
/free
return arraylist_create();
/end-free
P E
/**
* \brief Dispose JSON array
*
* Disposes a JSON array and all values it contains.
* All added arrays and objects are also disposed.
*
* \author Mihael Schmidt
* \date 19.04.2008
*
* \param Pointer to the JSON array
*/
P jsona_dispose B export
D PI
D array *
/free
if (array <> *null);
jsona_clear(array);
arraylist_dispose(array);
array = *null;
endif;
/end-free
P E
/**
* \brief Remove an entry from the array
*
* \param Pointer to the JSON array
* \param Index of the element to be removed (0-based)
*/
P jsona_remove B export
D PI opdesc
D array * const
D index 10I 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(array : index);
if (entry.type = JSON_TYPE_ARRAY);
jsona_dispose(entry.array);
elseif (entry.type = JSON_TYPE_OBJECT);
json_dispose(entry.object);
endif;
arraylist_remove(array : index);
/end-free
P E
/**
* \brief Clear array
*
* Removes all elements from the array.
*
* \param Pointer to the JSON array
*/
P jsona_clear B export
D PI
D array * const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
D size S 10I 0
D i S 10I 0
/free
size = arraylist_getSize(array);
for i = size-1 downto 0;
jsona_remove(array : i);
endfor;
/end-free
P E
/**
* \brief Add character entry
*
* Adds an entry of type character.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Value
* \param Index (default: last)
*/
P jsona_putString...
P B export
D PI opdesc
D jsonArrPtr * const
D value 65535A const options(*varsize)
D index 10U 0 const options(*nopass : *omit)
D valueLength 10I 0 const options(*nopass)
*
D l_index S 10U 0 inz(*hival)
/free
if (%parms() >= 3 and %addr(index) <> *null);
l_index = index;
endif;
if (%parms() = 4);
tmpl_array_entry.string = %subst(value : 1 : valueLength);
else;
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpl_array_entry.string = %subst(value : 1 : length);
endif;
tmpl_array_entry.type = JSON_TYPE_STRING;
if (l_index <> *hival);
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) :
length + 4 : index);
else;
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : length + 4);
endif;
/end-free
P E
/**
* \brief Add boolean entry
*
* Adds an entry of type boolean.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Value
* \param Index (default: last)
*/
P jsona_putBoolean...
P B export
D PI
D jsonArrPtr * const
D value N const
D index 10U 0 const options(*nopass)
/free
tmpl_array_entry.type = JSON_TYPE_BOOLEAN;
tmpl_array_entry.boolean = value;
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 5);
else;
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 5 : index);
endif;
/end-free
P E
/**
* \brief Add integer entry
*
* Adds an entry of type integer.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Value
* \param Index (default: last)
*/
P jsona_putInt...
P B export
D PI
D jsonArrPtr * const
D value 10I 0 const
D index 10U 0 const options(*nopass)
/free
tmpl_array_entry.type = JSON_TYPE_INT;
tmpl_array_entry.integer = value;
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 8);
else;
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 8 : index);
endif;
/end-free
P E
/**
* \brief Add long entry
*
* Adds an entry of type long.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Value
* \param Index (default: last)
*/
P jsona_putLong...
P B export
D PI
D jsonArrPtr * const
D value 20I 0 const
D index 10U 0 const options(*nopass)
/free
tmpl_array_entry.type = JSON_TYPE_LONG;
tmpl_array_entry.long = value;
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 12);
else;
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 12 : index);
endif;
/end-free
P E
/**
* \brief Add double entry
*
* Adds an entry of type double.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Value
* \param Index (default: last)
*/
P jsona_putDouble...
P B export
D PI
D jsonArrPtr * const
D value 8F const
D index 10U 0 const options(*nopass)
/free
tmpl_array_entry.type = JSON_TYPE_DOUBLE;
tmpl_array_entry.double = value;
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 12);
else;
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 12 : index);
endif;
/end-free
P E
/**
* \brief Add array entry
*
* Adds an entry of type array.
*
* \author Mihael Schmidt
* \date 19.04.2008
*
* \param Pointer to the JSON array
* \param Array
* \param Index (default: last)
*/
P jsona_putArray...
P B export
D PI
D jsonArrPtr * const
D value * const
D index 10U 0 const options(*nopass)
*
D entry DS likeds(tmpl_array_entry)
/free
entry.type = JSON_TYPE_ARRAY;
entry.array = value;
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(entry) : 32);
else;
arraylist_add(jsonArrPtr : %addr(entry) : 32 : index);
endif;
/end-free
P E
/**
* \brief Get string entry
*
* Returns a pointer to the value of the entry for the passed key.
* The value is null terminated and can be processed with the %str BIF.
*
*
*
* If the entry is not of type string an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Pointer to a null-terminated string
*/
P jsona_getString...
P B export
D PI *
D jsonArrPtr * const
D index 10U 0 const
*
D tmpPtr S *
D tmpDs DS likeds(tmpl_array_entry )
D based(tmpPtr)
/free
tmpPtr = arraylist_get(jsonArrPtr : index);
if (tmpPtr <> *null);
if (tmpDs.type = JSON_TYPE_STRING);
return tmpPtr + 4;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return *null; // dummy => will never come to this point
/end-free
P E
/**
* \brief Get boolean entry
*
* Returns the boolean value of the entry.
*
*
*
* If the entry is not of type boolean an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Boolean value of the entry
*/
P jsona_getBoolean...
P B export
D PI N
D jsonArrPtr * const
D index 10U 0 const
*
D tmpPtr S *
D tmpDs DS likeds(tmpl_array_entry )
D based(tmpPtr)
/free
tmpPtr = arraylist_get(jsonArrPtr : index);
if (tmpPtr <> *null);
if (tmpDs.type = JSON_TYPE_BOOLEAN);
return tmpDs.boolean;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return *off; // dummy => will never come to this point
/end-free
P E
/**
* \brief Get integer entry
*
* Returns the integer value of the entry.
*
*
*
* If the entry is not of type integer an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Integer value of the entry
*/
P jsona_getInt...
P B export
D PI 10I 0
D jsonArrPtr * const
D index 10U 0 const
*
D tmpPtr S *
D tmpDs DS likeds(tmpl_array_entry )
D based(tmpPtr)
/free
tmpPtr = arraylist_get(jsonArrPtr : index);
if (tmpPtr <> *null);
if (tmpDs.type = JSON_TYPE_INT);
return tmpDs.integer;
elseif (tmpDs.type = JSON_TYPE_LONG);
monitor;
return tmpDs.long;
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
elseif (tmpDs.type = JSON_TYPE_DOUBLE);
monitor;
return %int(tmpDs.double);
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return -1; // dummy => will never come to this point
/end-free
P E
/**
* \brief Get long entry
*
* Returns the long value of the entry.
*
*
*
* If the entry is not of type long an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Long value of the entry
*/
P jsona_getLong...
P B export
D PI 20I 0
D jsonArrPtr * const
D index 10U 0 const
*
D tmpPtr S *
D tmpDs DS likeds(tmpl_array_entry )
D based(tmpPtr)
/free
tmpPtr = arraylist_get(jsonArrPtr : index);
if (tmpPtr <> *null);
if (tmpDs.type = JSON_TYPE_LONG);
return tmpDs.long;
elseif (tmpDs.type = JSON_TYPE_INT);
return tmpDs.integer;
elseif (tmpDs.type = JSON_TYPE_DOUBLE);
monitor;
return %int(tmpDs.double);
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return -1; // dummy => will never come to this point
/end-free
P E
/**
* \brief Get double entry
*
* Returns the double value of the entry.
*
*
*
* If the entry is not of type double an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Double value of the entry
*/
P jsona_getDouble...
P B export
D PI 8F
D jsonArrPtr * const
D index 10U 0 const
*
D tmpPtr S *
D tmpDs DS likeds(tmpl_array_entry )
D based(tmpPtr)
/free
tmpPtr = arraylist_get(jsonArrPtr : index);
if (tmpPtr <> *null);
if (tmpDs.type = JSON_TYPE_DOUBLE);
return tmpDs.double;
elseif (tmpDs.type = JSON_TYPE_INT);
return %float(tmpDs.integer);
elseif (tmpDs.type = JSON_TYPE_LONG);
monitor;
return %float(tmpDs.long);
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return -1.0; // dummy => will never come to this point
/end-free
P E
/**
* \brief Get array entry
*
* Returns the array value of the entry.
*
*
*
* If the entry is not of type array an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Pointer to the JSON array
*/
P jsona_getArray...
P B export
D PI *
D array * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(array : index);
if (ptr <> *null);
if (entry.type = JSON_TYPE_ARRAY);
return entry.array;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return *null; // dummy => will never come to this point
/end-free
P E
/**
* \brief String representation of the JSON array in JSON syntax
*
* Creates a null terminated string representation of the JSON array in
* JSON syntax.
*
*
*
* For entries of type string double quotes and backslashes will be escaped
* (" => \" and \ => \\).
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON array
*
* \return Pointer to the JSON string for the passed array
*
* \info The allocated memory of the returned string must be deallocated
* by the caller.
*/
P jsona_toString...
P B export
D PI *
D jsonArrPtr * const
D pOutputFormat...
D 10I 0 const options(*nopass)
D pPrettyPrintFormat...
D likeds(json_prettyPrintFormat)
D const options(*nopass)
D pIndentationLevel...
D 10I 0 options(*nopass)
*
D outputFormat...
D S 10I 0
D prettyPrintOption...
D S N inz(*off)
D prettyPrintFormat...
D DS likeds(json_prettyPrintFormat) inz
D indentationLevel...
D S 10I 0 inz(0)
*
D l_chars DS likeds(tmpl_chars) inz
*
D json_string_ptr...
D S *
D json_string_length...
D S 10I 0
D tokenList S *
D tmpString S 310A
D tmpLength S 10I 0
D entry DS likeds(tmpl_array_entry)
D based(entryPtr)
D ptr S *
D x S 10I 0
D newline S 2A inz(x'0D25')
D i S 10I 0
D size S 10I 0
/free
if (%parms() >= 2);
outputFormat = pOutputFormat;
endif;
if (%parms() >= 3);
prettyPrintFormat = pPrettyPrintFormat;
endif;
if (%parms() = 4);
indentationLevel = pIndentationLevel;
endif;
exsr init;
if (outputFormat = JSON_OUTPUT_PRETTY_PRINT);
prettyPrintOption = *on;
endif;
// initialization
// - write start tag
// - init token list
tokenList = arraylist_create();
if (prettyPrintOption and prettyPrintFormat.breakBeforeArrayBrace);
arraylist_add(tokenList : %addr(newline) : %size(newline));
prettyPrint(tokenList : prettyPrintFormat : indentationLevel);
endif;
arraylist_add(tokenList : %addr(l_chars.l_bracket) :
l_chars.size_l_bracket);
if (prettyPrintOption);
prettyPrint(tokenList : prettyPrintFormat : indentationLevel);
if (prettyPrintFormat.breakAfterArrayBrace);
indentationLevel += 1;
arraylist_add(tokenList : %addr(newline) : %size(newline));
endif;
endif;
// process entries
size = %int(arraylist_getSize(jsonArrPtr)) - 1;
for i = 0 to size;
entryPtr = arraylist_get(jsonArrPtr : i);
if (prettyPrintOption);
prettyPrint(tokenList : prettyPrintFormat : indentationLevel);
endif;
select;
when (entry.type = JSON_TYPE_STRING);
arraylist_add(tokenList : %addr(l_chars.d_quote) :
l_chars.size_d_quote);
arraylist_add(tokenList : %addr(entry.string) :
strlen(%addr(entry.string)));
escapeLastToken(tokenList);
arraylist_add(tokenList : %addr(l_chars.d_quote) :
l_chars.size_d_quote);
when (entry.type = JSON_TYPE_INT);
tmpString = %char(entry.integer);
tmpLength = %len(%trimr(tmpString));
arraylist_add(tokenList : %addr(tmpString) : tmpLength);
when (entry.type = JSON_TYPE_LONG);
tmpString = %char(entry.long);
tmpLength = %len(%trimr(tmpString));
arraylist_add(tokenList : %addr(tmpString) : tmpLength);
when (entry.type = JSON_TYPE_DOUBLE);
tmpString = %triml(%char(entry.double) : '+');
tmpLength = %len(%trimr(tmpString));
// JSON syntax expects a . as delimiter (and not ,)
tmpString = %xlate(',' : '.' : tmpString);
arraylist_add(tokenList : %addr(tmpString) : tmpLength);
when (entry.type = JSON_TYPE_BOOLEAN);
if (entry.boolean);
arraylist_add(tokenList : %addr(l_chars.true):l_chars.size_true);
else;
arraylist_add(tokenList : %addr(l_chars.false) :
l_chars.size_false);
endif;
when (entry.type = JSON_TYPE_ARRAY);
ptr = jsona_toString(entry.array : outputFormat :
prettyPrintFormat : indentationLevel);
arraylist_add(tokenList : ptr : strlen(ptr));
dealloc(n) ptr;
when (entry.type = JSON_TYPE_NULL);
arraylist_add(tokenList : %addr(entry.string) : 4);
when (entry.type = JSON_TYPE_OBJECT);
ptr = json_toString(entry.object : outputFormat :
prettyPrintFormat : indentationLevel);
arraylist_add(tokenList : ptr : strlen(ptr));
endsl;
// add comma if it is not the last entry
if (entryPtr <> arraylist_getLast(jsonArrPtr));
arraylist_add(tokenList : %addr(l_chars.comma) : l_chars.size_comma);
if (prettyPrintOption and prettyPrintFormat.breakAfterElement);
arraylist_add(tokenList : %addr(newline) : %size(newline));
endif;
endif;
endfor;
if (prettyPrintOption);
if (prettyPrintFormat.breakAfterArrayBrace);
arraylist_add(tokenList : %addr(newline) : %size(newline));
indentationLevel -= 1;
endif;
prettyPrint(tokenList : prettyPrintFormat : indentationLevel);
endif;
// write end tag
arraylist_add(tokenList : %addr(l_chars.r_bracket) :
l_chars.size_r_bracket);
// calculate json string length
size = %int(arraylist_getSize(tokenList)) - 1;
for i = 0 to size;
ptr = arraylist_get(tokenList : i);
json_string_length += strlen(ptr);
endfor;
// +1 for hex Null
json_string_length += 1;
// allocate memory for json string
json_string_ptr = %alloc(json_string_length);
// build json string
size = %int(arraylist_getSize(tokenList)) - 1;
for i = 0 to size;
ptr = arraylist_get(tokenList : i);
tmpLength = strlen(ptr);
memcpy(json_string_ptr + x : ptr : tmpLength);
x += tmpLength;
endfor;
// append hex null
memcpy(json_string_ptr + x : %addr(hex_null) : 1);
// clean up
if (tokenList <> *null);
arraylist_dispose(tokenList);
endif;
return json_string_ptr;
begsr init;
if (outputFormat = JSON_OUTPUT_COMPACT);
l_chars = chars_compact;
else;
l_chars = chars;
endif;
endsr;
/end-free
P E
/**
* \brief Add null value entry
*
* Adds an entry of type null to the array.
*
* \author Mihael Schmidt
* \date 11.05.2008
*
* \param Pointer to the JSON array
* \param Index (default: last)
*/
P jsona_putNull B export
D PI
D jsonArrPtr * const
D index 10U 0 const options(*nopass)
/free
tmpl_array_entry.type = JSON_TYPE_NULL;
tmpl_array_entry.string = 'null';
if (%parms() = 1);
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 4 + 4);
else;
arraylist_add(jsonArrPtr : %addr(tmpl_array_entry ) : 4 + 4 : index);
endif;
/end-free
P E
/**
* \brief Add JSON object entry
*
* Adds an entry of type object to the array.
*
* \author Mihael Schmidt
* \date 11.05.2008
*
* \param Pointer to the JSON array
* \param Pointer to the JSON object
* \param Index (default: last)
*/
P jsona_putObject...
P B export
D PI
D jsonArrPtr * const
D objPtr * const
D index 10U 0 const options(*nopass)
*
D entry DS likeds(tmpl_array_entry)
/free
entry.type = JSON_TYPE_OBJECT;
entry.object = objPtr;
if (%parms() = 2);
arraylist_add(jsonArrPtr : %addr(entry) : 32);
else;
arraylist_add(jsonArrPtr : %addr(entry) : 32 : index);
endif;
/end-free
P E
/**
* \brief Get object entry
*
* Returns a pointer to the object.
*
*
*
* If the entry is not of type object an escape message will be send.
*
* \author Mihael Schmidt
* \date 11.05.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Pointer to the JSON object
*/
P jsona_getObject...
P B export
D PI *
D array * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(array : index);
if (ptr <> *null);
if (entry.type = JSON_TYPE_OBJECT);
return entry.object;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
endif;
return *null; // dummy => will never come to this point
/end-free
P E
/**
* \brief Get array size
*
* Returns the number of elements in the array.
*
* \param Pointer to the json array
*
* \return number of elements
*/
P jsona_size B export
D PI 10U 0
D jsonArrPtr * const
/free
return arraylist_getSize(jsonArrPtr);
/end-free
P E
/**
* \brief Get entry type
*
* Returns the type of the entry.
*
* \param Pointer to the JSON object
* \param Key
*
* \return Entry type
*
* \throws CPF9898 Array element not found
*/
P jsona_getEntryType...
P B export
D PI 10I 0
D array * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(array : index);
if (ptr <> *null);
return entry.type;
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
return 0; // dummy
endif;
/end-free
P E
/**
* \brief Checks if entry is of special type null
*
* \param Pointer to the JSON object
* \param Key
*
* \return *on = entry is of type null
* *off = entry is of another type
*/
P jsona_isNull...
P B export
D PI N
D array * const
D index 10U 0 const
*
D entry DS likeds(tmpl_array_entry) based(ptr)
/free
ptr = arraylist_get(array : index);
if (ptr <> *null);
return (entry.type = JSON_TYPE_NULL);
else;
sendEscapeMessage(MSG_ARRAY_ELEMENT_NOT_FOUND);
return *off; // dummy
endif;
/end-free
P E
json/json.rpgle 0000666 0001750 0001750 00000237237 12005141157 014045 0 ustar 00fist fist 0000000 0000000 /**
* \brief JSON Service program
*
* From the main web site:
*
*
*
*
*
*
* The pointer to the JSON object will be check on every procedure call.
* If the pointer does not point to a JSON object an escape message will
* be send to the next level of the call stack.
*
*
*
* If the JSON obect is queried for an entry of a specific type and the
* type does not match with the expectation of the procedure an escape
* message will be send to the next level of the call stack.
*
*
*
* All the allocated memory of the JSON object and its entries is managed
* by this service program and will be freed with the call of the
* procedure dispose. No manual deallocation must be done.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \link http://www.json.org JSON
*
* \rev 27.01.2010 Mihael Schmidt
* Added support for getting numbers with procedures json_getInt,
* json_getLong, json_getDouble no matter what the original type was
* (f. e. double value will be cast to int with json_getInt).
*
* \rev 13.02.2011 Mihael Schmidt
* Fixed bug in remove procedure. Replaced string and hex constants
* with unicode constants.
*
* \rev 09.04.2011 Mihael Schmidt
* Fixed memory management error in toString procedure.
*
* \rev 24.06.2011 Brian Garland
* Remove leading plus (+) from floating point numbers when creating
* a string from a json object.
*
* \rev 23.10.2011 Mihael Schmidt
* Switched from Linked List to Arraylist and by that removing a
* dependency to Linked List
* Fixed bug in escapeLastToken procedure
*
* \rev 22.01.2012 Matthias Aumüller
* Fixed bug in escapeLastToken procedure. Replaced constants with
* its unicode representation.
*
* \rev 31.01.2012 Klaus Meinhardt
* Fixed bug: duplicate key triggers escape message on put procedure
*
* \rev 24.07.2012 Hugo Cantor
* Bugfix: json_putString : wrong parameter value length from CEEDOD
* added new parm for length
*/
*-------------------------------------------------------------------------
* Copyright (c) 2007-2012 Mihael Schmidt
* All rights reserved.
*
* This file is part of the JSON service program.
*
* JSON service program is free software: you can redistribute it and/or modify it under
* the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* any later version.
*
* JSON service program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with JSON service program. If not, see http://www.gnu.org/licenses/.
*-------------------------------------------------------------------------
H nomain
H bnddir('QC2LE')
H copyright('Copyright (c) 2007-2012 Mihael Schmidt. All rights reserved.')
*-------------------------------------------------------------------------
* Prototypes
*-------------------------------------------------------------------------
D json_srvpgm_init...
D PR 10I 0 extproc('json_srvpgm_init')
*
/copy 'json_h.rpgle'
/copy 'json_int_h.rpgle'
/copy 'ceeapi_h.rpgle'
/copy 'libc_h.rpgle'
/copy 'arraylist_h.rpgle'
/if not defined (QUSEC)
/define QUSEC
/copy QSYSINC/QRPGLESRC,QUSEC
/endif
*-------------------------------------------------------------------------
* Constants
*-------------------------------------------------------------------------
D HEX_NULL C x'00'
D JSON_ID C 'JSON_IMPLEMENTATION'
/copy 'json_c.rpgle'
/copy 'unicode_c.rpgle'
*-------------------------------------------------------------------------
* Global Variables
*-------------------------------------------------------------------------
*
* Parameters passed to CEEDOD
*
D descType S 10I 0
D dataType S 10I 0
D descInfo1 S 10I 0
D descInfo2 S 10I 0
D length S 10I 0
*
D chars DS likeds(tmpl_chars)
D chars_compact DS likeds(tmpl_chars)
*
D hexNull S 1A inz(HEX_NULL)
*-------------------------------------------------------------------------
* Procedures
*-------------------------------------------------------------------------
/**
* \brief Service program initialization
*
* String formattings are preloaded.
*/
P json_srvpgm_init...
P B export
D PI 10I 0
/free
chars.d_quote = %char(UNICODE_DOUBLE_QUOTE) + x'00';
chars.l_brace = ' ' + %char(UNICODE_LEFT_CURLY_BRACE) + ' ' + x'00';
chars.r_brace = ' ' + %char(UNICODE_RIGHT_CURLY_BRACE) + ' ' + x'00';
chars.l_bracket = ' ' + %char(UNICODE_LEFT_BRACKET) + ' ' + x'00';
chars.r_bracket = ' ' + %char(UNICODE_RIGHT_BRACKET) + ' ' + x'00';
chars.comma = ' ' + %char(UNICODE_COMMA) + ' ' + x'00';
chars.colon = ' ' + %char(UNICODE_COLON) + ' ' + x'00';
chars.true = 'true' + x'00';
chars.false = 'false' + x'00';
chars.null_str = 'null' + x'00';
chars.size_d_quote = 1;
chars.size_l_brace = 3;
chars.size_r_brace = 3;
chars.size_l_bracket = 3;
chars.size_r_bracket = 3;
chars.size_comma = 3;
chars.size_colon = 3;
chars.size_true = 4;
chars.size_false = 5;
chars.size_null_str = 4;
chars_compact.d_quote = %char(UNICODE_DOUBLE_QUOTE) + x'00';
chars_compact.l_brace = %char(UNICODE_LEFT_CURLY_BRACE) + x'00';
chars_compact.r_brace = %char(UNICODE_RIGHT_CURLY_BRACE) + x'00';
chars_compact.l_bracket = %char(UNICODE_LEFT_BRACKET) + x'00';
chars_compact.r_bracket = %char(UNICODE_RIGHT_BRACKET) + x'00';
chars_compact.comma = %char(UNICODE_COMMA) + x'00';
chars_compact.colon = %char(UNICODE_COLON) + x'00';
chars_compact.true = 'true' + x'00';
chars_compact.false = 'false' + x'00';
chars_compact.null_str = 'null' + x'00';
chars_compact.size_d_quote = 1;
chars_compact.size_l_brace = 1;
chars_compact.size_r_brace = 1;
chars_compact.size_l_bracket = 1;
chars_compact.size_r_bracket = 1;
chars_compact.size_comma = 1;
chars_compact.size_colon = 1;
chars_compact.size_true = 4;
chars_compact.size_false = 5;
chars_compact.size_null_str = 4;
return 0;
/end-free
P E
/**
* \brief Create JSON Object
*
* Creates a JSON Object.
*
*
*
* The memory allocated for this object must be deallocated with the
* dispose procedure when finished.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \return Pointer to the JSON object
*/
P json_create B export
D PI *
*
D jsonPtr S *
D header DS likeds(tmpl_header) based(jsonPtr)
/free
jsonPtr = %alloc(%size(tmpl_header));
header.id = JSON_ID;
header.size = 0;
header.firstEntry = *null;
header.lastEntry = *null;
header.iteration = -1;
header.iterNextEntry = *null;
header.iterPrevEntry = *null;
header.disposeList = arraylist_create();
return jsonPtr;
/end-free
P E
/**
* \brief Deallocate JSON object
*
* The memory for the JSON Object will be deallocated and the passed
* pointer will be set to *null.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*/
P json_dispose B export
D PI
D jsonPtr *
*
D header DS likeds(tmpl_header) based(jsonPtr)
D ptr S *
D ptrDisposeElement...
D S * based(ptr)
D size S 10I 0
D i S 10I 0
/free
if (jsonPtr <> *null);
isJSONImpl(jsonPtr);
// deallocate all temporary allocated memory from the dispose list
size = arraylist_getSize(header.disposeList);
size -= 1;
for i = 0 to size;
// a user may have already freed the memory so ignore all errors
ptr = arraylist_get(header.disposeList : i);
monitor;
if (ptrDisposeElement <> *null);
dealloc ptrDisposeElement;
endif;
on-error *all;
endmon;
endfor;
arraylist_dispose(header.disposeList);
json_clear(jsonPtr);
dealloc(n) jsonPtr;
endif;
/end-free
P E
/**
* \brief Remove entry
*
* If the JSON object contains such an entry it will be removed.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Entry key
*
*/
P json_remove B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D ptr S *
D entry DS likeds(tmpl_entry) based(ptr)
D nextEntryPtr S *
D nextEntry DS likeds(tmpl_entry)
D based(nextEntryPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
ptr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
// check if entry was found
if (ptr <> *null);
// update header
if (header.firstEntry = ptr);
header.firstEntry = entry.next;
endif;
if (header.lastEntry = ptr);
header.lastEntry = entry.prev;
endif;
// update previous and next (if exist)
if (entry.prev <> *null);
prevEntryPtr = entry.prev;
prevEntry.next = entry.next;
endif;
if (entry.next <> *null);
nextEntryPtr = entry.next;
nextEntry.prev = entry.prev;
endif;
// release memory of entry value
disposeEntryValue(ptr);
dealloc(n) entry.key;
dealloc(n) ptr;
header.size -= 1;
endif;
/end-free
P E
/**
* \brief Clear JSON object
*
* Removes all entries from the JSON object.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*
*/
P json_clear B export
D PI
D jsonPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D tmpPtr S *
D ptr S *
D entry DS likeds(tmpl_entry) based(ptr)
/free
isJSONImpl(jsonPtr);
ptr = header.lastEntry;
dow (ptr <> *null);
tmpPtr = entry.prev;
// dispose/dealloc old value
disposeEntryValue(ptr);
dealloc(n) entry.key;
dealloc(n) ptr;
ptr = tmpPtr;
enddo;
// update header
header.size = 0;
header.firstEntry = *null;
header.lastEntry = *null;
header.iteration = -1;
header.iterNextEntry = *null;
header.iterPrevEntry = *null;
/end-free
P E
/**
* \brief Get next entry
*
* Iterates through all JSON entries and returns a pointer to the key of
* the next entry.
*
*
*
* If the iteration ends with the last key *null will be returned.
*
*
*
* If the iteration is aborted the calling program should use the
* abortIteration procedure to reset the iteration.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*
* \return Pointer to the key of the next entry or *null if there are no
* more entries
*/
P json_getNext B export
D PI *
D jsonPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S *
/free
isJSONImpl(jsonPtr);
if (header.iteration = header.size-1 or
header.iteration < -1);
header.iteration = -1;
retVal = *null;
else;
if (header.iterNextEntry = *null);
entryPtr = header.firstEntry;
else;
entryPtr = header.iterNextEntry;
endif;
header.iteration += 1;
header.iterNextEntry = entry.next;
retVal = entry.key;
endif;
return retVal;
/end-free
P E
/**
* \brief Abort iteration
*
* Resets the iteration of the JSON Object.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*/
P json_abortIteration...
P B export
D PI
D jsonPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
/free
isJSONImpl(jsonPtr);
header.iteration = -1;
header.iterNextEntry = *null;
header.iterPrevEntry = *null;
/end-free
P E
/**
* \brief Contains key
*
* Checks if the JSON object contains an entry with the passed key.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Entry key
*
* \return *on = JSON object contains key
* *off = JSON object does not contain key
*/
P json_contains...
P B export
D PI N opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D entryPtr S *
D retVal S N
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr = *null);
retVal = *off;
else;
retVal = *on;
endif;
return retVal;
/end-free
P E
/**
* \brief Is JSON object empty
*
* Checks if the JSON object contains no entries at all.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*
* \return *on = JSON object is empty
* *off = JSON object is not empty
*/
P json_isEmpty B export
D PI N
D jsonPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D retVal S N
/free
isJSONImpl(jsonPtr);
if (header.size = 0);
retVal = *on;
else;
retVal = *off;
endif;
return retVal;
/end-free
P E
/**
* \brief Count JSON object entries
*
* Returns the number of entries in the JSON object. The keys of the
* entries are counted. If the JSON object contains arrays the elements
* of the arrays are ignored.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*
* \return number of entries in the JSON object
*/
P json_size B export
D PI 10I 0
D jsonPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
/free
isJSONImpl(jsonPtr);
return header.size;
/end-free
P E
/**
* \brief Add character entry
*
* Adds an entry of type character.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
* \param Value
* \param Value length (optional)
*/
P json_putString B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 65535A const options(*varsize)
D pValueLength 10I 0 const options(*nopass)
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D tmpValue S 65535A
D keyLength S 10I 0
D valueLength S 10I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
if (%parms() = 3);
cee_getOpDescInfo(3 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
valueLength = length;
else;
valueLength = pValueLength;
endif;
tmpValue = %subst(value : 1 : valueLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = valueLength;
newEntry.value = %alloc(valueLength + 1); // +1 for the null byte
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_STRING;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = valueLength;
newEntry.value = %alloc(valueLength + 1); // +1 for the null byte
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
memcpy(newEntry.value : %addr(tmpValue) : valueLength);
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
memcpy(newEntry.value + valueLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add boolean entry
*
* Adds an entry of type boolean.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
* \param Value
*/
P json_putBoolean...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value N const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D keyLength S 10I 0
D tmpValue S N based(newEntry.value)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_BOOLEAN;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = 1;
newEntry.value = %alloc(1);
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_BOOLEAN;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = 1;
newEntry.value = %alloc(1);
endif;
// copy key/value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
tmpValue = value;
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add integer entry
*
* Adds an entry of type integer.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
* \param Value
*/
P json_putInt...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 10I 0 const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D keyLength S 10I 0
D tmpValue S 10I 0 based(newEntry.value)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_INT;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue));
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_INT;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue));
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
tmpValue = value;
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add long entry
*
* Adds an entry of type long.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
* \param Value
*/
P json_putLong...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 20I 0 const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D keyLength S 10I 0
D tmpValue S 20I 0 based(newEntry.value)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_LONG;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue));
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_LONG;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue));
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
tmpValue = value;
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add double entry
*
* Adds an entry of type double.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
* \param Value
*/
P json_putDouble...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value 8F const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D keyLength S 10I 0
D tmpValue S 8F based(newEntry.value)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_DOUBLE;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue));
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_DOUBLE;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
newEntry.valueLength = %size(tmpValue);
newEntry.value = %alloc(%size(tmpValue));
endif;
// copy value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
tmpValue = value;
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add array entry
*
* Adds an entry of type array.
*
* \author Mihael Schmidt
* \date 19.04.2008
*
* \param Pointer to the JSON object
* \param Key
* \param Array
*/
P json_putArray...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D value * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpKey S 65535A
D keyLength S 10I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_ARRAY;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = 0;
newEntry.value = *null;
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_ARRAY;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
newEntry.valueLength = 0;
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
endif;
// copy key to entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
// we use the direct ref/pointer to the array
newEntry.value = value;
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Get entry
*
* Gets the value of entry in the JSON object as a string.
*
*
*
* The return value is a pointer to a null terminated string so that it
* can be easily processed with the %str BIF.
*
*
*
* The memory for the return value was allocated will be managed by
* the JSON object and will be disposed with the dispose
* procedure. The calling program does not need to deallocate the
* the memory by itself.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Pointer to a null terminated string or *null if JSON object
* does not contain the passed key
*/
P json_get B export
D PI * opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S * inz(*null)
*
D tmpPtr S *
D tmpDs DS based(tmpPtr)
D tmpBoolean N overlay(tmpDs)
D tmpInt 10I 0 overlay(tmpDs)
D tmpLong 20I 0 overlay(tmpDs)
D tmpDouble 8F overlay(tmpDs)
D tmpString S 310A
D tmpLength S 10I 0
D hex_null S 1A inz(x'00')
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
select;
when (entry.type = JSON_TYPE_STRING);
retVal = %alloc(entry.valueLength + 1); // + 1 byte for the null value
// +1 because the null byte was already added to the string during putString
memcpy(retVal : entry.value : entry.valueLength + 1);
when (entry.type = JSON_TYPE_INT);
tmpPtr = entry.value;
tmpString = %char(tmpInt);
tmpLength = %len(%trimr(tmpString));
retVal = %alloc(tmpLength);
memcpy(retVal : %addr(tmpString) : tmpLength);
memcpy(retVal + tmplength : %addr(hex_null) : 1);
when (entry.type = JSON_TYPE_LONG);
tmpPtr = entry.value;
tmpString = %char(tmpLong);
tmpLength = %len(%trimr(tmpString));
retVal = %alloc(tmpLength);
memcpy(retVal : %addr(tmpString) : tmpLength);
memcpy(retVal + tmplength : %addr(hex_null) : 1);
when (entry.type = JSON_TYPE_DOUBLE);
tmpPtr = entry.value;
tmpString = %char(tmpDouble);
tmpLength = %len(%trimr(tmpString));
retVal = %alloc(tmpLength);
memcpy(retVal : %addr(tmpString) : tmpLength);
memcpy(retVal + tmplength : %addr(hex_null) : 1);
when (entry.type = JSON_TYPE_BOOLEAN);
tmpPtr = entry.value;
retVal = %alloc(%size(tmpBoolean));
memcpy(retVal : %addr(tmpDs) : %size(tmpBoolean));
memcpy(retVal + 1 : %addr(hex_null) : 1);
when (entry.type = JSON_TYPE_ARRAY);
retVal = jsona_toString(entry.value);
when (entry.type = JSON_TYPE_OBJECT);
retVal = json_toString(entry.value);
endsl;
endif;
// register this pointer to the dispose list so that the memory will be managed
if (retVal <> *null);
if (entry.type = JSON_TYPE_OBJECT);
// don't add this pointer to the dispose list
// it has already been added to the list in the toString procedure
else;
arraylist_add(header.disposeList : %addr(retVal) : 16);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get string entry
*
* Returns a pointer to the value of the entry for the passed key.
* The value is null terminated and can be processed with the %str BIF.
*
*
*
* If the entry is not of type string an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Pointer to a null-terminated string
*/
P json_getString B export
D PI * opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S * inz(*null)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_STRING);
retVal = entry.value;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get boolean entry
*
* Returns the boolean value of the entry.
*
*
*
* If the entry is not of type boolean an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Boolean value of the entry
*/
P json_getBoolean...
P B export
D PI N opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D value S N based(entry.value)
D retVal S N
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_BOOLEAN);
retVal = value;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get integer entry
*
* Returns the integer value of the entry.
*
*
*
* If the entry is not of type integer an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Integer value of the entry
*/
P json_getInt...
P B export
D PI 10I 0 opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D valueInt S 10I 0 based(entry.value)
D valueLong S 20I 0 based(entry.value)
D valueDouble S 8F based(entry.value)
D retVal S 10I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_INT);
retVal = valueInt;
elseif (entry.type = JSON_TYPE_LONG);
monitor;
retVal = valueLong;
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
elseif (entry.type = JSON_TYPE_DOUBLE);
monitor;
retVal = %int(valueDouble);
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get long entry
*
* Returns the long value of the entry.
*
*
*
* If the entry is not of type long an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Long value of the entry
*/
P json_getLong...
P B export
D PI 20I 0 opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D valueInt S 10I 0 based(entry.value)
D valueLong S 20I 0 based(entry.value)
D valueDouble S 8F based(entry.value)
D retVal S 20I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_LONG);
retVal = valueLong;
elseif (entry.type = JSON_TYPE_INT);
retVal = valueInt;
elseif (entry.type = JSON_TYPE_DOUBLE);
monitor;
retVal = %int(valueDouble);
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get double entry
*
* Returns the double value of the entry.
*
*
*
* If the entry is not of type double an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Double value of the entry
*/
P json_getDouble...
P B export
D PI 8F opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D valueInt S 10I 0 based(entry.value)
D valueLong S 20I 0 based(entry.value)
D valueDouble S 8F based(entry.value)
D retVal S 8F
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_DOUBLE);
retVal = valueDouble;
elseif (entry.type = JSON_TYPE_INT);
retVal = %float(valueInt);
elseif (entry.type = JSON_TYPE_LONG);
monitor;
retVal = %float(valueLong);
on-error *all;
sendEscapeMessage(MSG_TYPE_CAST_EXCEPTION);
endmon;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get array entry
*
* Returns the array value of the entry.
*
*
*
* If the entry is not of type array an escape message will be send.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
* \param Key
*
* \return Pointer to the JSON array
*/
P json_getArray...
P B export
D PI * opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S *
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_ARRAY);
retVal = entry.value;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief String representation of the JSON object in JSON syntax
*
* Creates a null terminated string representation of the JSON object in
* JSON syntax.
*
*
*
* For entries of type string double quotes and backslashes will be escaped
* (" => \" and \ => \\).
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*/
P json_toString B export
D PI *
D jsonPtr * const
D pOutputFormat...
D 10I 0 const options(*nopass)
D pPrettyPrintFormat...
D likeds(json_prettyPrintFormat)
D const options(*nopass)
D pIndentationLevel...
D 10I 0 options(*nopass)
*
D outputFormat S 10I 0
D prettyPrintOption...
D S N inz(*off)
D prettyPrintFormat...
D DS likeds(json_prettyPrintFormat) inz
D indentationLevel...
D S 10I 0 inz(0)
*
D l_chars DS likeds(tmpl_chars) inz
*
D json_string_ptr...
D S *
D json_string_length...
D S 10I 0
D tokenList S *
*
D tmpDs DS based(entry.value)
D tmpBoolean N overlay(tmpDs)
D tmpInt 10I 0 overlay(tmpDs)
D tmpLong 20I 0 overlay(tmpDs)
D tmpDouble 8F overlay(tmpDs)
D tmpArray * overlay(tmpDs)
D tmpString S 310A
D tmpLength S 10I 0
D hex_null S 1A inz(x'00')
D newline S 2A inz(x'0D25')
*
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
*
D ptr S *
D x S 10I 0
D i S 10I 0
D size S 10I 0
/free
isJSONImpl(jsonPtr);
if (%parms() = 2);
outputFormat = pOutputFormat;
prettyPrintFormat.useTabs = *off;
prettyPrintFormat.numberWhitespace = 4;
prettyPrintFormat.breakAfterElement = *on;
prettyPrintFormat.breakAfterObjectBrace = *on;
prettyPrintFormat.breakBeforeArrayBrace = *on;
prettyPrintFormat.breakAfterArrayBrace = *on;
elseif (%parms() = 3);
outputFormat = pOutputFormat;
prettyPrintFormat = pPrettyPrintFormat;
elseif (%parms() = 4);
outputFormat = pOutputFormat;
prettyPrintFormat = pPrettyPrintFormat;
indentationLevel = pIndentationLevel;
endif;
if (outputFormat = JSON_OUTPUT_PRETTY_PRINT);
prettyPrintOption = *on;
endif;
exsr init;
// initialisierung
// - anfangszeichen schreiben
// - tokenlist initialisieren
tokenList = arraylist_create();
arraylist_add(tokenList : %addr(l_chars.l_brace) :
%size(l_chars.size_l_brace));
if (prettyPrintOption);
if (prettyPrintFormat.breakAfterObjectBrace);
indentationLevel += 1;
arraylist_add(tokenList : %addr(newline) : %size(newline));
endif;
endif;
// einträge verarbeiten
entryPtr = header.firstEntry;
dow (entryPtr <> *null);
if (prettyPrintOption);
prettyPrint(tokenList : prettyPrintFormat : indentationLevel);
endif;
// add key as token to token list
arraylist_add(tokenList : %addr(l_chars.d_quote) :
l_chars.size_d_quote);
arraylist_add(tokenList : entry.key : entry.keyLength -1);
arraylist_add(tokenList : %addr(l_chars.d_quote) :
l_chars.size_d_quote);
// add key/value separator
arraylist_add(tokenList : %addr(l_chars.colon) : l_chars.size_colon);
select;
when (entry.type = JSON_TYPE_STRING);
arraylist_add(tokenList : %addr(l_chars.d_quote) :
l_chars.size_d_quote);
// +1 weil das null byte schon beim hinzufügen des wertes hinzugefügt wurde
arraylist_add(tokenList : entry.value : entry.valueLength + 1);
escapeLastToken(tokenList);
arraylist_add(tokenList : %addr(l_chars.d_quote) :
l_chars.size_d_quote);
when (entry.type = JSON_TYPE_INT);
tmpString = %char(tmpInt);
tmpLength = %len(%trimr(tmpString));
arraylist_add(tokenList : %addr(tmpString) : tmpLength);
when (entry.type = JSON_TYPE_LONG);
tmpString = %char(tmpLong);
tmpLength = %len(%trimr(tmpString));
arraylist_add(tokenList : %addr(tmpString) : tmpLength);
when (entry.type = JSON_TYPE_DOUBLE);
tmpString = %triml(%char(tmpDouble):'+');
tmpLength = %len(%trimr(tmpString));
// JSON Syntax erwartet immer ein . als Trennzeichen (und kein ,)
tmpString = %xlate(',' : '.' : tmpString);
arraylist_add(tokenList : %addr(tmpString) : tmpLength);
when (entry.type = JSON_TYPE_BOOLEAN);
if (tmpBoolean);
arraylist_add(tokenList : %addr(l_chars.true) :
l_chars.size_true);
else;
arraylist_add(tokenList : %addr(l_chars.false) :
l_chars.size_false);
endif;
when (entry.type = JSON_TYPE_ARRAY);
ptr = jsona_toString(entry.value : outputFormat:prettyPrintFormat:
indentationLevel);
arraylist_add(tokenList : ptr : strlen(ptr));
dealloc(n) ptr;
when (entry.type = JSON_TYPE_OBJECT);
ptr = json_toString(entry.value : outputFormat : prettyPrintFormat:
indentationLevel);
arraylist_add(tokenList : ptr : strlen(ptr));
when (entry.type = JSON_TYPE_NULL);
arraylist_add(tokenList : %addr(l_chars.null_str) :
l_chars.size_null_str);
endsl;
// komma hinzufügen falls es nicht der letzte eintrag ist
if (entryPtr <> header.lastEntry);
arraylist_add(tokenList : %addr(l_chars.comma) : l_chars.size_comma);
if (prettyPrintOption and prettyPrintFormat.breakAfterElement);
arraylist_add(tokenList : %addr(newline) : %size(newline));
endif;
endif;
// nächsten eintrag
entryPtr = entry.next;
enddo;
if (prettyPrintOption);
if (prettyPrintFormat.breakAfterObjectBrace);
arraylist_add(tokenList : %addr(newline) : %size(newline));
indentationLevel -= 1;
endif;
prettyPrint(tokenList : prettyPrintFormat : indentationLevel);
endif;
// endezeichen schreiben falls einträge vorhanden
arraylist_add(tokenList : %addr(l_chars.r_brace) : l_chars.size_r_brace);
// json string länge ermitteln
// calculate json string length
size = %int(arraylist_getSize(tokenList)) - 1;
for i = 0 to size;
ptr = arraylist_get(tokenList : i);
json_string_length += strlen(ptr);
endfor;
// +1 für hex Null
json_string_length += 1;
// speicher für json string reservieren
json_string_ptr = %alloc(json_string_length);
// build json string
size = %int(arraylist_getSize(tokenList)) - 1;
for i = 0 to size;
ptr = arraylist_get(tokenList : i);
tmpLength = strlen(ptr);
memcpy(json_string_ptr + x : ptr : tmpLength);
x += tmpLength;
endfor;
// hex Null anhängen
memcpy(json_string_ptr + x : %addr(hexNull) : 1);
// aufräumen
if (tokenList <> *null);
arraylist_dispose(tokenList);
endif;
// register allocated memory at the dispose list
if (json_string_ptr <> *null);
arraylist_add(header.disposeList : %addr(json_string_ptr) :
%size(json_string_ptr));
endif;
return json_string_ptr;
begsr init;
if (outputFormat = JSON_OUTPUT_COMPACT);
l_chars = chars_compact;
else;
l_chars = chars;
endif;
endsr;
/end-free
P E
/**
* \brief Add null value entry
*
* Adds an entry of type null to the array.
*
* \author Mihael Schmidt
* \date 11.05.2008
*
* \param Pointer to the JSON array
* \param Key
*/
P json_putNull B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpPtr S *
D tmpKey S 65535A
D keyLength S 10I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_NULL;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = 0;
newEntry.value = *null;
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_NULL;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
newEntry.valueLength = 0;
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
endif;
// copy key/value to the list entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Add JSON object entry
*
* Adds an entry of type object to the array.
*
* \author Mihael Schmidt
* \date 11.05.2008
*
* \param Pointer to the JSON array
* \param Key
* \param Pointer to the JSON object
*/
P json_putObject...
P B export
D PI opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
D objPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D prevEntryPtr S *
D prevEntry DS likeds(tmpl_entry)
D based(prevEntryPtr)
D newEntryPtr S *
D newEntry DS likeds(tmpl_entry)
D based(newEntryPtr)
D tmpKey S 65535A
D keyLength S 10I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
keyLength = length;
tmpKey = %subst(key : 1 : keyLength);
// check if key is in already in the map
newEntryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : keyLength);
if (newEntryPtr = *null); // entry not in json object
// create new entry
newEntryPtr = %alloc(%size(tmpl_entry));
newEntry.type = JSON_TYPE_OBJECT;
newEntry.keyLength = keyLength + 1; // +1 for the null byte
newEntry.key = %alloc(keyLength + 1); // +1 for the null byte
newEntry.valueLength = 0;
newEntry.value = *null;
newEntry.next = *null;
newEntry.prev = *null;
// update header
header.size += 1;
if (header.firstEntry = *null);
header.firstEntry = newEntryPtr;
else;
prevEntryPtr = header.lastEntry;
prevEntry.next = newEntryPtr;
newEntry.prev = prevEntryPtr;
endif;
header.lastEntry = newEntryPtr;
else;
// entry needs to be resized
newEntry.type = JSON_TYPE_OBJECT;
newEntry.keyLength = keyLength + 1;
newEntry.key = %realloc(newEntry.key : keyLength + 1);
newEntry.valueLength = 0;
// dispose/dealloc old value
disposeEntryValue(newEntryPtr);
endif;
// copy key and value to entry
memcpy(newEntry.key : %addr(tmpKey) : keyLength);
newEntry.value = objPtr;
// set null to the last byte
memcpy(newEntry.key + keyLength : %addr(hexNull) : 1);
/end-free
P E
/**
* \brief Get object entry
*
* Returns a pointer to the object.
*
*
*
* If the entry is not of type object an escape message will be send.
*
* \author Mihael Schmidt
* \date 11.05.2008
*
* \param Pointer to the JSON array
* \param Index
*
* \return Pointer to the JSON object
*/
P json_getObject...
P B export
D PI * opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S *
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
if (entry.type = JSON_TYPE_OBJECT);
retVal = entry.value;
else;
sendEscapeMessage(MSG_ENTRY_TYPE_MISMATCH);
endif;
endif;
return retVal;
/end-free
P E
/**
* \brief Get entry type
*
* Returns the type of the entry.
*
* \param Pointer to the JSON object
* \param Key
*
* \return Entry type
*/
P json_getEntryType...
P B export
D PI 10I 0 opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entry DS likeds(tmpl_entry) based(entryPtr)
D type S 10I 0
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
type = entry.type;
else;
sendEscapeMessage(MSG_ENTRY_NOT_FOUND);
endif;
return type;
/end-free
P E
/**
* \brief Checks if entry is of special type null
*
* \param Pointer to the JSON object
* \param Key
*
* \return *on = entry is of type null
* *off = entry is of another type
*/
P json_isNull B export
D PI N opdesc
D jsonPtr * const
D key 65535A const options(*varsize)
*
D tmpKey S 65535A
D header DS likeds(tmpl_header) based(jsonPtr)
D entry DS likeds(tmpl_entry) based(entryPtr)
/free
isJSONImpl(jsonPtr);
cee_getOpDescInfo(2 : descType : dataType : descInfo1 : descInfo2 :
length : *omit);
tmpKey = %subst(key : 1 : length);
entryPtr = getJSONEntry(jsonPtr : %addr(tmpKey) : length);
if (entryPtr <> *null);
return (entry.type = JSON_TYPE_NULL);
else;
sendEscapeMessage(MSG_ENTRY_NOT_FOUND);
return *off; // dummy
endif;
/end-free
P E
/**
* \brief Check for JSON object
*
* Checks if the passed pointer points to a JSON object.
*
*
*
* If the pointer does not point to a JSON object and escape message will
* be send to the next entry in the call stack.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to the JSON object
*/
P isJSONImpl...
P B export
D PI
D jsonPtr * const
*
D header DS likeds(tmpl_header) based(jsonPtr)
/free
monitor;
if (header.id <> JSON_ID);
sendEscapeMessage(MSG_NO_JSON_OBJECT);
endif;
on-error *all;
sendEscapeMessage(MSG_NO_JSON_OBJECT);
endmon;
/end-free
P E
/**
* \brief Send escape message
*
* A wrapper for the i5/OS API QMHSNDPM.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Message id
*/
P sendEscapeMessage...
P B export
D PI
D id 10I 0 const
*
D sendProgramMessage...
D PR extpgm('QMHSNDPM')
D szMsgID 7A const
D szMsgFile 20A const
D szMsgData 6000A const options(*varsize)
D nMsgDataLen 10I 0 const
D szMsgType 10A const
D szCallStkEntry...
D 10A const
D nRelativeCallStkEntry...
D 10I 0 const
D szRtnMsgKey 4A
D error 265A options(*varsize)
*
D msgdata S 512A
D msgkey S 4A
/free
if (id = MSG_NO_JSON_OBJECT);
msgdata = 'The pointer does not point to a JSON object data structure';
elseif (id = MSG_ENTRY_TYPE_MISMATCH);
msgdata = 'The entry type does not match with the expected type.';
elseif (id = MSG_ARRAY_ELEMENT_NOT_FOUND);
msgdata = 'The specified array element was not found in the array.';
elseif (id = MSG_TYPE_CAST_EXCEPTION);
msgdata = 'The specified entry could not be cast to the requested ' +
'type.';
else;
return;
endif;
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage('CPF9898' :
'QCPFMSG *LIBL ' :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*ESCAPE ' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
/end-free
P E
/**
* \brief Get entry by key
*
* Returns a pointer to the entry data structure for the passed key.
*
* \param Pointer to the JSON object
* \param Pointer to the key
* \param Key length
*
* \return Pointer to the entry or *null if no such entry exists in this
* JSON object.
*/
P getJSONEntry B export
D PI *
D jsonPtr * const
D keyPtr * const
D keyLength 10U 0 const
*
D header DS likeds(tmpl_header) based(jsonPtr)
D entryPtr S *
D entry DS likeds(tmpl_entry) based(entryPtr)
D retVal S * inz(*null)
/free
entryPtr = header.firstEntry;
dow (entryPtr <> *null);
if (keyLength = entry.keyLength - 1 and
memcmp(keyPtr : entry.key : keyLength) = 0); // dont include the null
retVal = entryPtr;
leave;
endif;
entryPtr = entry.next;
enddo;
return retVal;
/end-free
P E
/**
* \brief Escape characters
*
* Double quotes and backslashes must be escape in string values to
* comply to the JSON specs.
*
*
*
* The last element of the token list will be checked for characters
* which need to be escaped.
*
* \author Mihael Schmidt
* \date 20.03.2008
*
* \param Pointer to token list
*/
P escapeLastToken...
P B export
D PI
D tokenList *
*
D ptr S *
D length S 10I 0
D backslash S 1A
D newPtr S *
D newLength S 10I 0
D newCurLength S 10I 0
D i S 10I 0
D x S 10I 0
D iPtr S *
D char S 1A based(iPtr)
/free
backslash = UNICODE_BACKSLASH;
ptr = arraylist_getLast(tokenList);
length = strlen(ptr);
newLength = length;
// number of character to be escaped
for i = 0 to length - 1;
iPtr = ptr + i;
if (char = UNICODE_BACKSLASH or char = UNICODE_DOUBLE_QUOTE);
newLength += 1;
endif;
endfor;
// check if there are any characters which need to be escaped
if (newLength <> length);
newPtr = %alloc(newLength);
for i = 0 to length - 1;
iPtr = ptr + i;
if (char = UNICODE_BACKSLASH or char = UNICODE_DOUBLE_QUOTE);
memcpy(newPtr + newCurLength : ptr + x : i - x);
newCurLength += i - x;
// copy escape character
memcpy(newPtr + newCurLength : %addr(backslash) : 1);
newCurLength += 1;
x = i; // save last position
endif;
endfor;
// copy the rest of the string
memcpy(newPtr + newCurLength : ptr + x : i - x + 1);
newCurLength += i - x;
// replace value in token list
arraylist_removeLast(tokenList);
arraylist_add(tokenList : newPtr : newCurLength);
dealloc(n) newPtr;
endif;
/end-free
P E
/**
* \brief Dealloc entry value
*
* The value of an entry is deallocated. If the entry is of
* type object or array it must be disposed.
*
* \author Mihael Schmidt
* \date 14.05.2008
*
* \param Pointer to an entry
*/
P disposeEntryValue...
P B export
D PI
D entryPtr *
*
D entry DS likeds(tmpl_entry) based(entryPtr)
/free
if (entry.type = JSON_TYPE_ARRAY);
jsona_dispose(entry.value);
elseif (entry.type = JSON_TYPE_OBJECT);
json_dispose(entry.value);
elseif (entry.type = JSON_TYPE_NULL);
// do nothing, entry is already *null
elseif (entry.value <> *null);
dealloc(n) entry.value;
endif;
/end-free
P E
/**
* \brief Send diagnostic message
*
* Sends a diagnostic message to the call stack
* (one level above this one).
*
* \author Mihael Schmidt
* \date 07.03.2009
*
* \param Message
*/
P sendDiagnosticMessage...
P B export
D PI
D message 200A const
*
D sendProgramMessage...
D PR extpgm('QMHSNDPM')
D szMsgID 7A const
D szMsgFile 20A const
D szMsgData 6000A const options(*varsize)
D nMsgDataLen 10I 0 const
D szMsgType 10A const
D szCallStkEntry...
D 10A const
D nRelativeCallStkEntry...
D 10I 0 const
D szRtnMsgKey 4A
D error 265A options(*varsize)
*
D msgdata S 512A
D msgkey S 4A
/free
msgdata = message;
clear QUSEC;
QUSBPRV = 0;
sendProgramMessage(*blank :
*blank :
%trimr(msgdata) :
%len(%trimr(msgdata)) :
'*DIAG' :
'*PGMBDY' :
0 :
msgkey :
QUSEC);
/end-free
P E
P prettyPrint B export
D PI
D tokenList * const
D printFormat const likeds(json_prettyPrintFormat)
D indentationLevel...
D 10I 0 const
*
D indentSpace S 1000A static inz
D indentTab S 1000A static inz(*ALLx'05')
/free
if (printFormat.useTabs);
arraylist_add(tokenList : %addr(indentTab) :
indentationLevel * printFormat.numberWhitespace);
else;
arraylist_add(tokenList : %addr(indentSpace) :
indentationLevel * printFormat.numberWhitespace);
endif;
/end-free
P E