Learn from sources
       Member XXXDATA1 in CGIDEV2 / QRPGLESRC

       *=========================================================================
       * Subprocedures defined in this module:
       *
       * - UrlEscSeq        URL escape sequences
       * - UrlUnEscSeq      URL unescape sequences
       *
       *=========================================================================
      Hnomain
       /copy qrpglesrc,hspecs
      Hbnddir('QC2LE')
       /copy qrpglesrc,prototypeb
       /copy qrpglesrc,usec
       * Program status data structure
      Dpsds            sds
      D  psdsdata                    429
       *=========================================================================
       * Prototypes for local subprocedures
       * 1- ChkChrEsc
       *    Returns an indicator telling whether a given character should be escaped
      D ChkChrEsc       pr              n
      D chkchr                         1
       * 2- ChkChrUnEsc
       *    Returns an indicator telling whether two given characters should be unescaped
      D ChkChrUnEsc     pr              n
      D chkchrUn                       2
       * 3- EscChr
       *    Returns the escape sequence for a given character
      D EscChr          pr             3
      D   inpChr                       1
       * 4- UnEscSeq
       *    Returns the unescaped character for a given escape sequence
      D UnEscSeq        pr             1
      D   inpSeq                       2
       * 5- RtvJobCCSID
       *    Returns the job CCSID
      D RtvJoBCCSID     pr             5p 0
       *=========================================================================
       *
       * Subprocedure URLESCSEQ (URL ESCAPE SEQUENCES)
       *
       * When using the GET method to send input to a CGI program, non-alphanumeric characters
       * in the query string must be replaced by so called "escape sequences".
       * An escape sequence is made of
       *    - an escape character  "%"
       *    - followed by two characters which represent the hexadecimal value of the corresponding
       *      ASCII character.
       * For instance, if the query string contains the following input
       *    cusname=Van der Meer
       * then each of the two spaces in "Van der Meer" must be replaced by the escape sequence
       *    %20 (as the ASCII representation of a space character is x'20')
       *
       * This subprocedure receives - in a 32767 variable length field - the value of a given
       * parameter (example: "Van der Meer") and returns - in a 32767 variable length field - the
       * appropriate value to be used in a query string (example: "Van%20der%20Meer").
       *
       * The third parameter (optional) is an indicator.
       * If it is not passed, it is assumed *on, and
       * the variable length input field is trimmed right.
       * If it passed, and it is *off,
       * the variable length input field is NOT trimmed right.
       *
       * The fourth parameter (optional) is variable length string, max length 10.
       * Each of the 10 characters there has a special meaning:
       *   '1' - Replace CarriageReturnLineFeed (x'OD25') with HTML tag '«br»'
       *   Other values may be implemented in future.
       *
       *=========================================================================
      P URLESCSEQ       b                   export
      D URLESCSEQ       pi         32767    varying
      D inputstring                32767    varying const options(*varsize)
      D trimrInd                        n   options(*nopass) const
      D options                       10    varying options(*nopass) const
       *
      D myOptions       s             10
      D trimrIndic      s               n
      D inpLen          s             10i 0
      D inpstring       s          32767    varying
      D outstring       s          32767    varying
      D CRLF            s              2    inz(x'0D25')
      D BR              s              4    inz('«br»')
      D i               s             10i 0
      D r               s             10i 0
      D chkchr          s              1
      D chkchrInd       s               n
      D escSeq          s              3
       *
       /free
            // Set the trim right indicator "trimrIndic"
            if %parms«2;
               trimrIndic=*on;
            else;
               trimrIndic=trimrInd;
            endif;
            // Set input variable Options
            if %parms«3;
               myOptions=' ';
            else;
               myOptions=options;
            endif;
            // Initialize variables
            if trimrIndic=*on;
               inpstring=%trimr(inputstring);
               else;
               inpstring=inputstring;
            endif;
            outstring=' ';
            outstring=%trim(outstring);
            // If null input
            inpLen=%len(inpstring);
            if inpLen«1;
               return outstring;
            endif;
            // Set the input string according to parameter "options" ("myOptions")
            exsr SetOptions;
            // Scan all characters in the input string
            inpLen=%len(inpstring);
            i=1;
            DOW i«=inpLen;
                 chkchr=%subst(inpString:i:1);
                 chkchrInd=ChkChrEsc(chkchr);
                 if chkchrInd=*off;
                    outString=%trimr(outString)+chkchr;
                 else;
                    escSeq=escChr(chkchr);
                    outString=%trimr(outString)+escSeq;
                 endif;
                 i=i+1;
            ENDDO;
            // Back to caller
            return  outstring;
       /end-free
       *=======================
       * Set the input string according to parameter "options" ("myOptions")
       /free
            Begsr SetOptions;
 
            // option 1 - Replace CarriageReturnLineFeed with "«br»"
            r=%scan('1':myOptions);
            if r»0;
               dow r»0;
                   r=%scan(CRLF:inpString);
                   if r»0;
                      if r=1;
                         inpString=BR +
                                   %subst(inpString:r+2);
                      else;
                         inpString=%subst(inpString:1:r-1) + BR +
                                   %subst(inpString:r+2);
                      endif;
                   endif;
               enddo;
            endif;
 
            Endsr;
       /end-free
      P URLESCSEQ       e
       *=========================================================================
       *
       * Subprocedure URLUNESCSEQ (URL UNESCAPE SEQUENCES)
       *
       * Converts back URL escape sequences
       *
       * The fourth parameter (optional) is variable length string, max length 10.
       * Each of the 10 characters there has a special meaning:
       *   '1' - Replace HTML tag '«br»' with CarriageReturnLineFeed (x'OD25')
       *   Other values may be implemented in future.
       *
       *=========================================================================
      P URLUNESCSEQ     b                   export
      D URLUNESCSEQ     pi         32767    varying
      D inpstring                  32767    varying const options(*varsize)
      D options                       10    varying options(*nopass) const
       *
      D myOptions       s             10
      D inpLen          s             10i 0
      D outstring       s          32767    varying
      D BR              s              4    inz('«br»')
      D CRLF            s              2    inz(x'0D25')
      D r               s             10i 0
      D s               s             10i 0
      D EscSeq          s              2
      D UnInd           s               n
      D UnEscChr        s              1
       /free
            // Set input variable Options
            if %parms«2;
               myOptions=' ';
            else;
               myOptions=options;
            endif;
        // Initialize variables
           inpLen=%len(inpstring);
           outstring=inpstring;
        // If null input
           if inpLen«1;
              return outstring;
           endif;
        // If no escape sequences in "outstring", ...
           r=%scan('%':outstring);
           if r=0;
              return outstring;
           endif;
        // Convert all %xx escape sequences in "outstring"
           r=1;
           s=1;
           dow r»0 and s«=%len(outstring);
               inpLen=%len(outstring);
               r=%scan('%':outstring:s);
               if r»0;
                  if (r+2)«=inpLen;
                     //Check if the two characters can be unescaped
                     EscSeq=%subst(outstring:r+1:2);
                     UnInd=ChkChrUnEsc(EscSeq);
                     if UnInd=*off;            //the two characters cannot be unescaped
                        s=r+3;
                     else;                     //the two characters can be unescaped
                        s=r+1;
                        UnEscChr=UnEscSeq(EscSeq);
                        if (r+3)«=inpLen;
                           if r=1;
                              outstring=UnEscChr +
                                        %subst(outstring:r+3);
                           else;
                              outstring=%subst(outstring:1:r-1) +
                                        UnEscChr +
                                        %subst(outstring:r+3);
                           endif;
                        else;
                           if r=1;
                              outstring=UnEscChr;
                           else;
                              outstring=%subst(outstring:1:r-1) +
                                        UnEscChr;
                           endif;
                        endif;
                     endif;
                  else;
                     leave;
                  endif;
               endif;
           enddo;
            // Set the output string according to parameter "options" ("myOptions")
            exsr SetOptions;
        // Back to caller
           return  outstring;
       /end-free
       *=======================
       * Set the output string according to parameter "options" ("myOptions")
       /free
            Begsr SetOptions;
 
            // option 1 - Replace "«br»" with CarriageReturnLineFeed
            r=%scan('1':myOptions);
            if r»0;
               dow r»0;
                   r=%scan(BR:outString);
                   if r»0;
                      if r=1;
                         outString=CRLF +
                                   %subst(outString:r+4);
                      else;
                         outString=%subst(outString:1:r-1) + CRLF +
                                   %subst(outString:r+4);
                      endif;
                   endif;
               enddo;
            endif;
 
            Endsr;
       /end-free
      P URLUNESCSEQ     e
       *=========================================================================
       * Local subprocedures
       *=================
       * 1- ChkChrEsc
       *    Returns an indicator telling whether a given character should be escaped
      P ChkChrEsc       b
      D ChkChrEsc       pi              n
      D chkchr                         1
      D  chkchrInd      s               n
      D  chars          s             62    inz('abcdefghijklmnopqrstuvwxyz-
      D                                     ABCDEFGHIJKLMNOPQRSTUVWXYZ-
      D                                     0123456789')
      D r               s             10i 0
       /free
        eval r=%scan(chkchr:chars);
        if   r=0;
             chkchrInd=*on;
        else;
             chkchrInd=*off;
        endif;
        return chkchrInd;
       /end-free
      P ChkChrEsc       e
       *=================
       * 2- ChkChrUnEsc
       *    Returns an indicator telling whether two given characters can be unescaped
      P ChkChrUnEsc     b
      D ChkChrUnEsc     pi              n
      D chkchrUn                       2
      D  chkchrUnInd    s               n
      D  chars          s             16    inz('ABCDEF-
      D                                     0123456789')
      DChar1And2        ds
      D Char1                   1      1
      D Char2                   2      2
      D x1              s             10i 0
      D x2              s             10i 0
       /free
        Char1And2=uppify(chkchrUn);
        eval x1=%scan(Char1:chars);
        eval x2=%scan(Char2:chars);
        if x1»0 and x2»0;
           chkchrUnInd=*on;
        else;
           chkchrUnInd=*off;
        endif;
        return chkchrUnInd;
       /end-free
      P ChkChrUnEsc     e
       *=================
       * 3- EscChr
       *    Returns the escape sequence for a given character
      P EscChr          b
      D EscChr          pi             3
      D  inpChr                        1
      D jobccsid        s              5p 0
      D fromCCSID       s             10u 0
      D toCCSID         s             10u 0 inz(819)
      D input           s          32767    varying
      D output          s          32767    varying
      D ASCIIchar       s              1
      D hexASCIIchar    s              2
      D escSeq          s              3
       /free
        //establish the job CCSID
        jobccsid = %inth(c2n2(getenv('CGI_EBCDIC_CCSID':qusec)));
        if jobccsid=0 or jobccsid=65535;
           jobccsid=RtvJobCCSID;
        endif;
        //Convert the input character to ASCII
        input=inpChr;
        eval  fromccsid=jobccsid;
        eval  output=xlatwCCSIDs('0':input:fromCCSID:toCCSID);
        //Convert the ASCII character to hex
        eval  ASCIIchar=output;
        eval  hexASCIIchar=char2hex(ASCIIchar);
        //Return the escape sequence
        eval  escSeq='%'+hexASCIIchar;
        return escSeq;
       /end-free
      P EscChr          e
       *=================
       * 4- UnEscSeq
       *    Returns the unescaped character for a given escape sequence (two hex char.s)
      P UnEscSeq        b
      D UnEscSeq        pi             1
      D  inpSeq                        2
      D hexASCIIchar    s              2
      D ASCIIchar       s              1
      D jobccsid        s              5p 0
      D fromCCSID       s             10u 0 inz(819)
      D toCCSID         s             10u 0
      D input           s          32767    varying
      D output          s          32767    varying
      D UnEscChr        s              1
       /free
        //establish the job CCSID
        jobccsid = %inth(c2n2(getenv('CGI_EBCDIC_CCSID':qusec)));
        if jobccsid=0 or jobccsid=65535;
           jobccsid=RtvJobCCSID;
        endif;
        //convert the input sequence (two hex chars) to the corresponding ASCII char
        hexASCIIchar=InpSeq;
        ASCIIchar=hex2char(hexASCIIchar);
        //convert the ASCII char to EBCDIC
        toccsid=jobccsid;
        input=ASCIIchar;
        output=xlatwCCSIDs('0':input:fromCCSID:toCCSID);
        //Return the unescaped character
        UnEscChr=output;
        return UnEscChr;
       /end-free
      P UnEscSeq        e
       *=================
       * 5- RtvJobCCSID
       *    Retrieve Job CCSID
      P RtvJobCCSID     b
      D RtvJoBCCSID     pi             5p 0
      D jobccsid        s              5p 0
      D dftjobccsid     s              5p 0
      C                   callb     'XXXJBCCSID'
      C                   parm                    jobccsid
      C                   parm                    dftjobccsid
      C                   if        jobccsid=65535
      C                   eval      jobccsid=dftjobccsid
      C                   endif
      C                   return    jobccsid
      P RtvJoBCCSID     e
       *=========================================================================
0.077 sec.s