*=========================================================================
* 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 '
'
* 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('
')
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 "
"
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 '
' 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('
')
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 "
" 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
*=========================================================================
|