A Simple JSON Generator in RPGLE
I wrote this service program to generate JSON from an external data structure. The way to use it is to read a file that has an external data structure associated with it and convert the record into JSON. Below is the service program prototype, implementation, and a sample program that uses the service program. This version supports data types of numeric, character, and boolean. Since DB2/400 doesn’t have a native “bit” type I’ve implemented it in DDS as a 1-byte character field with valid values of ‘0’ and ‘1’. The procedure “$JsonParseRec” has a parameter named “pBoolFieldList”, which is a list of field names that should be treated as boolean.
Adding the date type and others can be implemented as needed.
Here is the prototype, $JSONP:
/IF DEFINED($JSON)
/EOF
/ENDIF
/DEFINE $JSON
* Maximum length of a JSON document:
dcl-s $JsonMaxDoc varchar(1000000) template;
* Maximum length of a string value:
dcl-s $JsonMaxString varchar(32767) template;
dcl-ds $JsonFfdDs qualified template;
name varchar(25);
type char(1) ;
digits packed(2: 0);
precision packed(2: 0);
bytes packed(5: 0);
end-ds;
dcl-pr $JsonParseRec;
pFileName varchar(10) const;
pFileLib varchar(10) const;
pRecDs pointer const;
pFieldList varchar(1024) const options(*omit: *nopass);
pBoolFieldList varchar(1024) const options(*omit: *nopass);
end-pr;
dcl-pr $JsonInit;
pDoc like($JsonMaxDoc) const options(*nopass);
end-pr;
dcl-pr $JsonStrObj;
end-pr;
dcl-pr $JsonEndObj;
end-pr;
dcl-pr $JsonStrArr;
pName varchar(25) const;
end-pr;
dcl-pr $JsonEndArr;
end-pr;
dcl-pr $JsonAddDec;
pName varchar(25) const;
pValue packed (30: 9) const;
pPrecision packed (1: 0) const options(*nopass);
end-pr;
dcl-pr $JsonAddBool;
pName varchar(25) const;
pValue ind const;
end-pr;
dcl-pr $JsonAddString;
pName varchar(25) const;
pValue like($JsonMaxString) value;
end-pr;
dcl-pr $JsonDoc like($JsonMaxDoc);
end-pr;
Here’s the implementation ($JSON):
ctl-opt nomain;
ctl-opt option(*srcstmt: *nodebugio);
ctl-opt decEdit('0.');
ctl-opt debug;
/copy MLLIB/QRPGLESRC,$JSONP
/copy MLLIB/QRPGLESRC,$FILEP
/copy MLLIB/QRPGLESRC,$ERRORP
/copy MLLIB/QRPGLESRC,$UTILP
/copy MLLIB/QRPGLESRC,TRUE_FALSE
//---------------------------------------------------------------------
// Global Variables
//---------------------------------------------------------------------
dcl-s #jsonDoc like($JsonMaxDoc);
//---------------------------------------------------------------------
// External Procedure Declarations
//---------------------------------------------------------------------
dcl-pr #memcpy extProc('memcpy');
@dest pointer value;
@src pointer value;
@length uns(10) value;
end-pr;
//---------------------------------------------------------------------
// Procedure Definitions
//---------------------------------------------------------------------
dcl-proc #seperator;
if %len(#jsonDoc) > 0 and #lastChar <> '{';
#jsonDoc += ',';
endif;
end-proc;
//-----------------------------------------------------------
dcl-proc #lastChar;
dcl-pi *N char(1) end-pi;
if %len(#jsonDoc) = 0;
return ' ';
endif;
return %subst(#jsonDoc: %len(#jsonDoc): 1);
end-proc;
//-----------------------------------------------------------
dcl-proc $JsonInit EXPORT;
dcl-pi *N;
pDoc like($JsonMaxDoc) const options(*nopass);
end-pi;
clear #jsonDoc;
if %parms() = 1;
#jsonDoc = pDoc;
endif;
end-proc;
//---------------------------------------------------------------------
dcl-proc $JsonParseRec EXPORT;
dcl-pi *N;
pFileName varchar(10) const;
pFileLib varchar(10) const;
pRecDs pointer const;
pFieldList varchar(1024) const options(*omit: *nopass);
pBoolFieldList varchar(1024) const options(*omit: *nopass);
end-pi;
dcl-s #fileName varchar(10) static;
dcl-s #fileLib varchar(10) static;
dcl-s #fieldList varchar(1024) static;
dcl-ds #ffdData likeDs($FileFfdData) inz static;
dcl-ds #fieldsDs likeDs($UtilSplitDs) inz static;
dcl-s #boolFieldList varchar(1024) static;
dcl-ds #boolFieldsDs likeDs($UtilSplitDs) inz static;
dcl-s #type char(1);
dcl-s #string like($JsonMaxString);
dcl-s #bytes packed(5: 0);
dcl-s #prec packed(2: 0);
dcl-s #zoneI zoned(30: 0);
dcl-s #packI packed(30: 0);
dcl-s #packD packed(30: 9);
dcl-s #i packed(5: 0);
dcl-s #fieldName varchar(10);
dcl-ds #errorDs likeDs($ErrorDs) inz;
if pFileName <> #fileName or pFileLib <> #fileLib;
#ffdData = $FileDspFfd(pFileName: pFileLib: '*FIRST': #ErrorDs);
#fileName = pFileName;
#fileLib = pFileLib;
clear #fieldList;
clear #boolFieldList;
endif;
if %parms() >= 4;
if %addr(pFieldList) <> *null;
if #fieldList <> pFieldList;
#fieldList = pFieldList;
#fieldsDs = $UtilSplitString(pFieldList: ',');
endif;
else;
if #fieldList = *blanks;
for #i = 1 to #ffdData.Count;
#fieldList += %trim(#ffdData.Fields(#i).Name) + ',';
endfor;
#fieldsDs = $UtilSplitString(#fieldList: ',');
endif;
endif;
endif;
if %parms() >= 5 and
%addr(pBoolFieldList) <> *null and #boolFieldList <> pBoolFieldList;
#boolFieldList = pBoolFieldList;
#boolFieldsDs = $UtilSplitString(#boolFieldList: ',');
endif;
if #lastChar = '}';
#jsonDoc += ',';
endif;
#jsonDoc += '{';
for #i = 1 to #ffdData.Count;
if #fieldsDs.elems > 0 and
%lookup(#ffdData.Fields(#i).Name:
#fieldsDs.str:
1:
#fieldsDs.elems) = 0;
iter;
endif;
#fieldName = %trim(#ffdData.Fields(#i).Name);
#type = #ffdData.Fields(#i).Type;
#bytes = #ffdData.Fields(#i).Bytes;
#prec = #ffdData.Fields(#i).Precision;
select;
// Packed/Signed
when #type = 'P' or #type = 'S';
if #type = 'P';
clear #packI;
#memcpy(%addr(#packI) + %size(#packI) - #bytes:
pRecDs + #ffdData.Fields(#i).InputPos - 1:
#bytes);
else;
clear #zoneI;
#memcpy(%addr(#zoneI) + %size(#zoneI) - #bytes:
pRecDs + #ffdData.Fields(#i).InputPos - 1:
#bytes);
#packI = #zoneI;
endif;
#packD = #packI / %int(10 ** #prec);
$JsonAddDec(#fieldName: #packD: #prec);
// Boolean
when #type = 'A' and %lookup(#fieldName:
#boolFieldsDs.str:
1:
#boolFieldsDs.elems) > 0;
%len(#string) = 1;
#memcpy(%addr(#string: *data):
pRecDs + #ffdData.Fields(#i).InputPos - 1:
1);
$JsonAddBool(#fieldName: #string);
// Character
when #type = 'A';
%len(#string) = #bytes;
#memcpy(%addr(#string: *data):
pRecDs + #ffdData.Fields(#i).InputPos - 1:
#bytes);
$JsonAddString(#fieldName: #string);
other;
$JsonAddString('UNKNOWN DATA TYPE': #type);
endsl;
endfor;
#jsonDoc += '}';
end-proc $JsonParseRec;
//-----------------------------------------------------------
dcl-proc $JsonStrObj EXPORT;
if %len(#jsonDoc) > 0 and #lastChar = '}';
#jsonDoc += ',';
endif;
#jsonDoc += '{';
end-proc;
//----------------------------------------------------------
dcl-proc $JsonEndObj EXPORT;
#jsonDoc += '}';
end-proc;
//-----------------------------------------------------------
dcl-proc $JsonStrArr EXPORT;
dcl-pi *N;
pName varchar(25) const;
end-pi;
#Seperator();
#jsonDoc += '"' + pName + '": [';
end-proc;
*-----------------------------------------------------------
dcl-proc $JsonEndArr EXPORT;
#jsonDoc += ']';
end-proc;
*-----------------------------------------------------------
dcl-proc $JsonAddDec EXPORT;
dcl-pi *N;
pName varchar(25) const;
pValue packed(30: 9) const;
pPrecision packed(1: 0) const options(*nopass);
end-pi;
dcl-s #tempA char(30);
dcl-s #p packed(5: 0);
#Seperator();
#jsonDoc += '"' + pName + '":';
evalr #tempA = %char(pValue);
if %parms() = 3;
#p = %scan('.': #tempA);
if pPrecision = 0;
#jsonDoc += %trim(%subst(#tempA: 1: #p-1));
else;
#jsonDoc += %trim(%subst(#tempA: 1: #p+pPrecision));
endif;
else;
#jsonDoc += %trim(#tempA);
endif;
end-proc;
*-----------------------------------------------------------
dcl-proc $JsonAddBool EXPORT;
dcl-pi *N;
pName varchar(25) const;
pValue ind const;
end-pi;
#Seperator();
#jsonDoc += '"' + pName + '":';
if pValue = *on;
#jsonDoc += 'true';
else;
#jsonDoc += 'false';
endif;
end-proc;
*-----------------------------------------------------------
dcl-proc $JsonAddString EXPORT;
dcl-pi *N;
pName varchar(25) const;
pValue like($JsonMaxString) value;
end-pi;
#Seperator();
pValue = %scanrpl('\': '\\': pValue);
pValue = %scanrpl('"': '\"': pValue);
#jsonDoc += '"' + pName + '":"' + %trim(pValue) + '"';
end-proc;
*-----------------------------------------------------------
dcl-proc $JsonDoc EXPORT;
dcl-pi *N like($JsonMaxDoc) end-pi;
return #jsonDoc;
end-proc;
*-----------------------------------------------------------
Here’s a sample that implements the service program:
FITEM IF E DISK
FSALESHIST IF E DISK
d #itemDs e ds extName('DATA/ITEM')
d #itemDsP s * inz(%addr(#itemDs))
d #salesDs e ds extName('DATA/SALESHIST')
d #salesDsP s * inz(%addr(#salesDs))
d #jsonDoc s like($JsonMaxDoc)
d r# s 5p 0 inz
/COPY MLLIB/QRPGLESRC,$JSONP
// ITEM: Include only columns ICO, INO, and IDESC:
$JsonInit();
$JsonStrObj();
$JsonStrArr('Inventory');
setll 1 ITEM;
for r# = 1 to 50;
read ITEM;
$JsonParseRec('ITEM': 'DATA': #itemDsP:
'ICO,INO,IDESC');
endfor;
$JsonEndArr();
$JsonEndObj();
#jsonDoc = $JsonDoc();
// SALESHIST: Include all fields in the record by not including the
"pFieldList" parameter:
$JsonInit();
$JsonStrObj();
$JsonStrArr('SALESHIST');
setgt *hival SALESHIST;
for r# = 1 to 10;
readp SALESHIST;
$JsonParseRec('SALEHIST': 'DATA': #salesDsP);
endfor;
$JsonEndArr();
$JsonEndObj();
#jsonDoc = $JsonDoc();
*inlr = *on;
return;