A Simple JSON Generator in RPGLE

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;                                                                  

Leave a Reply

Your email address will not be published.