/*START OF CGIParse-------------------------------------Version-01.00-*/
/*:CGIParse() function - parses HTML form data passed via CGI.        */
/* Parameters:                                                        */
/*   PREFIX(ppp) - Optional Prefix for variable names created by this */
/*                 function. Can be a stem name, or just some chars.  */
/*   VARLIST(varname) - Optional output variable name that contains a */
/*          list of all of the variables created by CGIPARSE.         */
/*                                                                    */
/* Returns: 0, or an error message.                                   */
/* Note1: This function handles both HTML methods, GET and POST.      */
/* Note2: If a SELECT form variable has the multiple attribute, the   */
/*        data will be returned as a stem variable (even if only 1    */
/*        option was chosen). To help the caller determine this, the  */
/*        name returned in the varlist is suffixed with a '.'         */
/*--------------------------------------------------------------------*/
CGIParse: /* No expose here because we create arbitrarily named       */
          /* variables for the caller.                                */
TRACE N
_cgi.0err=_CGIParse1(ARG(1))       /* Process the cgi data            */
IF _cgi.0err <> 0 THEN RETURN _cgi.0err   /* Return if error          */

/* Create CGI form variables, user caller-provided prefix             */
  DO _cgi.0i = 1 TO WORDS(_cgi.0names)
  _cgivarname = WORD(_cgi.0names, _cgi.0i)
  IF RIGHT(_cgivarname, 1) = '.' THEN
    DO _cgi.0j = 0 TO VALUE('_cgi.0data.'_cgivarname'0')
    CALL VALUE _cgi.0prefix''_cgivarname'.'_cgi.0j,
              ,VALUE('_cgi.0data.'_cgivarname''_cgi.0j)
    END _cgi.0j
  ELSE CALL VALUE _cgi.0prefix''_cgivarname, _cgi.0data._cgivarname
  END _cgi.0i

IF _cgi.0varlist <> ''                     /* Caller wants a varList? */
THEN CALL VALUE _cgi.0varlist, _cgi.0names /* Yes, create it.         */
DROP _cgi. _cgivarname
RETURN 0

_CGIParse1: PROCEDURE EXPOSE gbl. __environment. query_string _cgi.
TRACE N
PARSE UPPER ARG 1 'PREFIX(' _cgi.0prefix ')',
                1 'VARLIST(' _cgi.0varlist ')'
_cgi.0names = ''                   /* Init list of varnames to create */

PARSE SOURCE env . execname
IF WORDPOS(env,'TSO OPS/REXX') > 0
THEN PARSE VAR execname execname the_rest

request_method = RxGetEnv('REQUEST_METHOD')
  SELECT
  WHEN request_method = 'POST' THEN
    IF SYMBOL('query_string') = 'LIT' THEN
      DO /* If query string already exists, then we were called       */
         /* before, and we have already read from stdin. We can't     */
         /* re-read the same stdin data, so we use what we have saved.*/
      content_length = RxGetEnv('CONTENT_LENGTH')
      IF DATATYPE(content_length) = 'NUM' THEN
        SELECT
        WHEN env = 'TSO' THEN
          INTERPRET "ADDRESS SYSCALL",
                    "'READ 0 query_string" content_length "'"
        WHEN WORDPOS(env,'WindowsNT NT') > 0 THEN
          query_string = CHARIN(,,content_length)
        OTHERWISE
          SAY 'CGIParse1: Unsupported environment:' src
        END
      END
  WHEN request_method = 'GET' THEN
    DO
    query_string= RxGetEnv('QUERY_STRING')
    END
  OTHERWISE
    rc='Error, invalid request_method:' request_method
    RETURN rc
  END

/* query_string=name=Joe+Bob&gender=Male=&text=punctuation%3A+%2C.%2F */
/* Convert any plus signs (+) in QUERY_STRING to spaces; result->Input*/
input=TRANSLATE(query_string,' ','+')
  DO WHILE input <> ''
  PARSE VAR input varname '=' value '&' input
  varName = TRANSLATE(varName)     /* Upper-case the variable name to */
                                   /* avoid OPS/MVS case-sensitivity  */
                                   /* issues on stem variable tails.  */
  value = DecodeAscii(value)

    SELECT
    WHEN SYMBOL('_cgi.0data.'varname'.0') = 'VAR' THEN
      DO /* We've seen this variable multiple times, append this      */
         /* value onto the end of the stem variable...                */
      CALL VALUE '_cgi.0data.'varname'.0',
                ,VALUE('_cgi.0data.'varname'.0') + 1
      CALL VALUE '_cgi.0data.'varname'.'VALUE('_cgi.0data.'varname'.0'),
                ,value
      END
    WHEN WORDPOS(varname,_cgi.0names) = 0 THEN
      DO /* We've never seen this variable before...                  */
      _cgi.0names = SPACE(_cgi.0names' 'varname)
      CALL VALUE '_cgi.0data.'varname, value
      END
    OTHERWISE
      /* We've seen this variable once before, now we'll convert it   */
      /* into a stem variable...                                      */
      CALL VALUE '_cgi.0data.'varname'.0', 2
      CALL VALUE '_cgi.0data.'varname'.1', VALUE('_cgi.0data.'varname)
      CALL VALUE '_cgi.0data.'varname'.2', value
      DROP _cgi.0data.varname      /* no need for the original value  */
      /* Remove the original (scalar) name from the varname list      */
      _cgi.0names = DELWORD(_cgi.0names,WORDPOS(varname,_cgi.0names),1)
      /* Replace original name with the stemname                      */
      _cgi.0names = SPACE(_cgi.0names' 'varname'.')
    END
  END /* DO WHILE input <> '' */
RETURN 0

/*--------------------------------------------------------------------*/
/*:DecodeAscii() function - returns CGI data variable with the %nn    */
/*   data expanded into characters.                                   */
/*   Most browsers insert ASCII codes (preceded by a %) for some      */
/*   characters such as space or +.                                   */
/*--------------------------------------------------------------------*/
DecodeAscii: PROCEDURE EXPOSE gbl.
TRACE N
input = ARG(1)
  DO WHILE POS('%',input) <> 0
  PARSE VAR input pre '%' +1 char +2 input
  IF VERIFY(TRANSLATE(Char),'0123456789ABCDEF')=0 THEN
    IF 'A' = 'C1'x
    THEN input=pre''TOEBCDIC(X2C(Char))''input
    ELSE input=pre''X2C(Char)''input
  ELSE input=pre''X2C('27')''char''input
  END
input=TRANSLATE(input, '%', X2C('27'))
RETURN input

/*END OF CGIParse-----------------------------------------------------*/

/*RXCOPY TOEBCDIC NODUP 0 LINES COPIED ON 05-27-03 AT 11:53************/

/*RXCOPY RXGETENV NODUP 0 LINES COPIED ON 05-27-03 AT 11:53************/