Learn from sources
       Member XXXDECODE2 in CGIDEV2 / QRPGLESRC

       *=============================================================================================
       *  EXPORTED SUBPROCEDURES IN THIS MODULE
       *  - Decode2   Transforms characters entities (e.g. '>') to characters (e.g. '»')
       *=============================================================================================
      hnomain
       /copy qrpglesrc,hspecs
 
       * CGIDEV2 library prototypes
       /copy qrpglesrc,prototypeb
 
       * Standard error data structure
       /copy qrpglesrc,usec
 
       * Program status data structure
      D psds           sds
      D  psdsdata                    429
      D  psdsjobnam                   10    overlay(psdsdata:244)
      D  psdsusrnam                   10    overlay(psdsdata:254)
      D  psdsjobnbr                    6    overlay(psdsdata:264)
 
       * Buffer for IFS stat function
      D StatusBuffer    ds                  align
      D  StsPermissions...
      D                               10u 0
      D  StsFileID                    10u 0
      D  StsLinkCount                  5u 0
      D  StsUserIDNbr                 10u 0
      D  StsGroupIdNbr                10u 0
      D  StsBytesInFile...
      D                               10i 0
      D  StsTimeLastAcc...
      D                               10i 0
      D  StsTimeLastChg...
      D                               10i 0
      D  StsTimeStsLastChg...
      D                               10i 0
      D  StsFileSysID                 10u 0
      D  StsBlockSize                 10u 0
      D  StsAllocBytes                10u 0
      D  StsObjectType                11
      D  StsCodePage                   5u 0
      D                               62
      D  StsGenerationID...
      D                               10u 0
 
      D rc              s             10i 0
 
       ******************************************************************
       * Decode2 subprocedure
       ******************************************************************
       * Uses an input varying length field to create and return a
       * varying length field in which selected input character entities
       * changed to the their corresponding charactes.
 
       * The characters entities to be converted are defined in an IFS file,
       * specified in the third parameter. If the third parameter is
       * not passed, a default file, /cgidevexthml/encod2arr.txt, is used.
       *
       * Characters entities not defined in the IFS file are not converted.  Instead,
       * the are returned without change.  For example:
       *
       *    Input:     >HTML<
       *    Output:    «HTML»
       *
       * Parameters
       * ----------
       * - Input
       *   - Char 65528, varying. The string to be decoded.
       * - ReturnCode
       *   - 10i 0
       *      0 successful,
       *     -1 file error (could be any of the following)
       *        (at run time, a detailed message is sent to the CGIDEBUG
       *        debugging file):
       *             - file not found
       *             - file not accessible (authority, etc.)
       *             - file empty
       *             - file contains no valid records
       *     -2 one or more data errors, usually invalid entity value
       *        (details in debugging file)
       *
       * - EntitiesFile - file that contains the arrays of characters
       *                  and character entities
       *   - Char 256, *options(*nopass) varying
       *     - Arrays of characters and entities are loaded at run time
       *       this file.  If the EntitiesFile parameter is not passed, file
       *       /cgiexthtml/encode2fil.txt is used.  Otherwise, the
       *       EntitiesFile file is used.
       *
       * Customizing the character entity list
       * -------------------------------------
       * - The default data are stored in /cgidevExtHTML/encode2fil.txt.
       *   It is recommended that you NOT modify, move, or rename this
       *   file because it could be replaced whenever CGIDEV2 is updated
       *   or reinstalled.  Instead,
       *     - Copy the default file to an IFS file of your own.
       *     - Make sure user QTMHHTP1 has *RX authority to your file
       *     - Modify your file.
       *       - One record per line
       *         - Comment records
       *           - Positions 1 -2 must be //.
       *         - Data records
       *           - Position 1: the character to be encoded
       *           - Positions 2 - 9: the character entity to be substituted for
       *                       the character.  If these positions are blank,
       *                       the record is ignored.
       *           - Remainder of record: blanks or comments
       *     - Use your file in the EntitiesFile parameter.
 
       * The input field can be up to 65528 bytes.  Because
       * it is varying, be sure that its length is set
       * correctly. Here are a few examples:
 
       *   - Passing a literal
       *                  eval      result = decode2('<html>':rc)
       *   - Passing a varying field.
       *                  eval      vfield = '<html>'
       *                  eval      result = encode2(vfield:rc)
       *   - Passing from a fixed length field
       *                  eval      ffield = '<html>'
       *                  eval      result = encode2(%trimr(ffield):rc)
 
      P Decode2         b                   export
      D Decode2         pi         65528    varying
      D  InputString               65528    const options(*varsize) varying
      D  ReturnCode                   10i 0
      D  EntitiesFile                256    const varying options(*nopass)
 
      D ThisSubProc     c                   'Decode2: '
 
       * Entities array.  Indexed by numeric value of input character
       * Loaded from the EntitiesFile file.  For optimum performance,
       * it is reloaded only when EntitiesFile's name or timestamp changes.
      D Entities        s              8    varying dim(255) static
      D Chars           s              1    dim(255) static
 
       * File and file handling variables
      D TheFile         s                   like(EntitiesFile)
      D                                     inz('/cgidevexthtml/encode2fil.txt')
      D FileHandle      s             10i 0
      D PrevFile        s                   like(EntitiesFile) static
      D PrevFileTS      s             10i 0 static
      D FileData        ds         65528    based(FileDataP)
      D   TheChar                      1
      D   TheEntity                    8
      D   FirstTwo                     2    overlay(FileData:1)
      D   n2                           3u 0 overlay(FileData:1)
      D WkFileP         s               *
 
       * Input and output variables
      D wkInputString   s                   like(InputString) based(p)
      D result          s          65528    varying
      D OneChar         ds                  based(p)
      D  c                             1
      D  n                             3u 0 overlay(c)
      D pVar            s               *
      D pVarEnd         s               *
      D Input8          ds                  based(pVar)
      D  ThisInput8                    8
      D  ThisInput8Str                 1    overlay(ThisInput8:1)
      D ThisEntity      s              8
      D SemicolPos      s             10i 0
      D allocSize       s             10u 0
      D x               s             10i 0
 
       * Variables for handling newline characters
      D TwoChars        ds
      D   c1                           1
      D   c2                           1
      D hex250D         s              2    inz(x'250D')
      D NewLineSeq      s              2    varying
      D NewLineSeqLen   s             10i 0
 
       * Other variables
      D GoodRecords     s             10i 0 static
      D BytesRead       s             10i 0
      D i               s             10i 0
 
       /free
        // Set up file name
        if %parms = 3;
          TheFile = EntitiesFile;
        endif;
 
        // Check file's existence
        ReturnCode = 0;
        if        stat(TheFile:%addr(StatusBuffer)) = -1;
          wrtDebug(ThisSubproc + 'Could not access IFS file ' +
                     TheFile + '. errno and text are: ' +
                     %trim(%editc(errno:'P')) + ', ' +
                     %trimr(ErrnoTxt(Errno)):*on);
          ReturnCode = -1;
          PrevFile = '';
          PrevFileTS = 0;
          GoodRecords = 0;
          Return result;
        endif;
 
        // If file is not the the same as before, read it
        if (PrevFile «» TheFile) or (PrevFileTS «» StsTimeLastChg); // new file
          goodRecords = 0;
          // Check for empty file
          if StsBytesInFile = 0;
            wrtDebug(ThisSubproc + ' ' + theFile +
                       ' is empty.':*on);
            ReturnCode = -1;
            PrevFile = '';
            PrevFileTS = 0;
            Return result;
          endif;
 
          // Open the file
          FileHandle = open(TheFile:O_RDONLY + O_TEXTDATA);
          if FileHandle = -1;
            wrtdebug(ThisSubProc + ' Could not open file ' + TheFile +
                     ' File system reported the following error: ' +
                       errnotxt(errno):*on);
            Returncode = -1;
            PrevFile = '';
            PrevFileTS = 0;
            Return result;
          endif;
 
          // Save file name and timestamp
          PrevFile = TheFile;
          PrevFileTS = StsTimeLastChg;
 
          // Read the file into dynamically allocated storage
          FileDataP = %alloc(StsBytesInFile + 32767);
          BytesRead = read(FileHandle:FileDataP:StsBytesInFile);
 
          // Close file
          rc = close(FileHandle);
 
          // Handle read failed
          if BytesRead = -1;
            wrtdebug(ThisSubProc + ' Could not read file ' + TheFile +
                     ' File system reported the following error: ' +
                       errnotxt(errno):*on);
            ReturnCode = -1;
            PrevFile = '';
            PrevFileTS = 0;
            Return result;
          endif;
 
          // Determine what is being used to define a new line.  It is
          // usually x'0D25', but could be x'250D', x'25', x'0D'
          // Find first x'0d' or x'25'.  Then examine next character to
          // determine what the end of line sequence is.
          i = 1;
          dou %scan(c1:hex250d) » 0;
            c1 = %subst(FileData:i:1);
            i = i + 1;
          enddo;
          c2 = %subst(FileData:i:1);
          if twochars = x'0D25' or twochars = x'250D';
            NewLineSeq = twochars;
          else;
            NewLineSeq = c1;
          endif;
          NewLineSeqLen = %len(NewLineSeq);
 
          // Add an additional newline to end of file
          WkFileP = FileDataP;
          FileDataP = FileDataP + StsBytesInFile;
          %subst(FileData:1:%len(NewLineSeq)) = NewLineSeq;
          FileDataP = WkFileP;
 
          // Build and process array elements
          entities(*) = '';
          i = 1;
          dow FileDataP - WkFileP « StsBytesInFile;
            i = %scan(NewLineSeq:FileData);
            // skip comments
            if firsttwo = '//' or TheEntity = *blanks;
              FileDataP = FileDataP + i + NewLineSeqLen - 1;
              iter;
            endif;
            // skip invalid entities but set return code to -2
            if %subst(TheEntity:1:1) «» '&' or
                   %subst(TheEntity:%len(%trimr(theEntity)):1) «» ';';
              wrtDebug(ThisSubproc + ' Invalid entity, ' + %trimr(TheEntity) +
                         ' for character ' + theChar + '.':*on);
              ReturnCode = -2;
              FileDataP = FileDataP + i + NewLineSeqLen - 1;
              Iter;
            endif;
            // add entry to arrays
            Entities(n2) = %trim(TheEntity);
            Chars(n2) = TheChar;
            FileDataP = FileDataP + i + NewLineSeqLen - 1;
            GoodRecords = GoodRecords + 1;
          enddo;
          if GoodRecords = 0;
            ReturnCode = -1;
            Return result;
          endif;
          // Deallocate storage
          FileDataP = WkFileP;
          dealloc FileDataP;
        endif; // it's a new file
 
        // Process the request
        if GoodRecords = 0;
          returnCode = -1;
          return result;
        endif;
 
        allocSize=%len(InputString)+10;
        p=%alloc(allocSize);
        wkInputString = InputString;
        pVar=p+2;
        pVarEnd=pVar+%len(InputString)-1;
        dow pVar«=pVarEnd;
            if thisInput8Str='&';
               semicolPos=%scan(';':thisInput8:2);
               if semicolPos»0;
                  thisEntity=%subst(thisInput8:1:semicolPos);
                  x=%lookup(thisEntity:Entities);
                  if x»0;
                     result=result+Chars(x);
                     pVar=pVar+semicolPos;
                     iter;
                  endif;
               endif;
            endif;
            result=result+thisInput8Str;
            pVar+=1;
        enddo;
        dealloc p;
 
        return result;
 
        //***********************************************************************
        // Program status subroutine
        //********************************************************************
        begsr *pssr;
          wrtpsds(psds);
        endsr;
       /end-free
      P Decode2         e
 
0.042 sec.s