H debug(*yes)



      *********************************************************************

      *  Test program for RPG CGI-BIN processing

      *  Accept input from HTML form, print variables.

      *  Return dynamic page as repsonse.

      *********************************************************************

      *  Copyright (c) 2000, Craig Pelkie

      *  ALL RIGHTS RESERVED

      *

      *  Craig Pelkie

      *  Bits & Bytes Programming, Inc.

      *  craig@web400.com  http://www.web400.com

      *********************************************************************



      ****************************************************************

      * arrNames  - array of field names parsed from HTML form

      * arrValues - array of field values parsed from HTML form

      * varCount  - number of array elements returned

      *

      * No assumptions are made about the data in a field. For

      * example, numeric fields are returned left-justified in

      * the array.

      *

      * The program needs to take care of any special

      * formatting required to use the data (for example, right-

      * justify and zero-fill numeric fields).

      ****************************************************************

     D arrNames        s             30    dim(100)

     D arrValues       s             60    dim(100)

     D varCount        s              9b 0 inz(0)



     D htmlStmt        s             80

     D i               s              5  0

     D n               s              5  0



     D arrHtml         s             80    dim(24) ctdata perrcd(1)



      ****************************************************************

      * Constants used in program

      *

      *  crlf      - Carriage Return / Line Feed

      *  htContent - used to set HTML content type header

      ****************************************************************

     D crlf            c                   x'15'

     D htContent       c                   'Content-Type: text/html'



      ****************************************************************

      * Prototype for MakeHTML function

      ****************************************************************

     D MakeHTML        pr

     D   StringIn                   254    value



      ****************************************************************

      * Prototype for ReplaceToken function

      ****************************************************************

     D ReplaceToken    pr            80

     D   htmlStmt                    80    value

     D   arrNames                    30    value dim(100)

     D   arrValues                   60    value dim(100)



     D/COPY QSYSINC/QRPGLESRC,QUSEC



     C                   eval      *inlr = *on



      ****************************************************************

      *  Call CGIPARSE to parse STDIN, return as arrays

      ****************************************************************



     C                   call      'CGIPARSE'

     C                   parm                    arrNames

     C                   parm                    arrValues

     C                   parm                    varCount



      ****************************************************************

      * Dump/Return if any error on call

      ****************************************************************



     C                   if        %error  = *on

     C                   dump

     C                   return

     C                   endif



      ****************************************************************

      * R E S P O N S E   H T M L

      ****************************************************************

      * Content-Type

      ****************************************************************



     C                   callp     MakeHTML(htContent +

     C                                      crlf      +

     C                                      crlf)



      ****************************************************************

      * Process array of HTML statements

      ****************************************************************



     C                   eval      n = %elem(arrHtml)

     C     1             do        n             i



     C                   eval      htmlStmt = ReplaceToken(arrHtml(i) :

     C                                                     arrNames   :

     C                                                     arrValues)

     C                   callp     MakeHTML(htmlStmt +

     C                                      crlf)

     C                   enddo



     C                   return





      ****************************************************************

      * Function MakeHTML

      *

      *  Write string to StdOut

      ****************************************************************

     P MakeHTML        b



     D MakeHTML        pi

     D  StringIn                    254    value



     D Work            s                   like(StringIn)

     D StdOutLen       s              9B 0



      ****************************************************************

      * Calculate length of StdOut string

      ****************************************************************



     C                   eval      Work      = %trim(StringIn)

     C                   eval      StdOutLen = %len(Work)



      ****************************************************************

      * Call QtmhWrStout API to write response HTML to StdOut

      ****************************************************************



     C                   callb     'QtmhWrStout'                        99

     C                   parm                    Work

     C                   parm                    StdOutLen

     C                   parm                    QUSEC



     P MakeHTML        e







      ****************************************************************

      * Function ReplaceToken

      *

      *  Scan a statement for replacement tokens, replace token

      *  with corresponding value from name/value arrays.

      *  Multiple tokens per statement are processed.

      ****************************************************************

     P ReplaceToken    b



     D ReplaceToken    pi            80

     D   htmlStmt                    80    value

     D   arrNames                    30    value dim(100)

     D   arrValues                   60    value dim(100)



     D endAt           s              5  0

     D k               s              5  0

     D replaceLength   s              5  0

     D replaceText     s             60

     D replaceVar      s             30

     D startAt         s              5  0



     D startToken      c                   '<%='

     D endToken        c                   '%>'



      ****************************************************************

      * Look for start token in statement

      ****************************************************************



     C                   dow       1 = 1

     C                   eval      startAt = %scan(startToken : htmlStmt)



     C                   if        startAt = 0

     C                   leave

     C                   endif



      ****************************************************************

      * Start token found, locate end token

      ****************************************************************



     C                   eval      endAt = %scan(endToken : htmlStmt)



     C                   if        endAt = 0

     C                   leave

     C                   endif



      ****************************************************************

      * End token found, extract replacement variable

      ****************************************************************



     C                   eval      replaceVar = %subst(htmlStmt :

     C                                          startAt + 3     :

     C                               (endAt - 1) - (startAt + 3))



     C                   eval      replaceVar = %trim(replaceVar)



      ****************************************************************

      * Get replacement text for replacement variable

      ****************************************************************



     C                   eval      replaceText = replaceVar



     C                   eval      k = 1

     C     replaceVar    lookup    arrNames(k)                            99



     C                   if        *in99 = *on

     C                   eval      replaceText = arrValues(k)

     C                   endif



      ****************************************************************

      * Put replacement text into statement

      ****************************************************************



     C                   eval      replaceLength = (endAt + 2) - startAt



     C                   eval      htmlStmt = %replace(%trim(replaceText) :

     C                                                 htmlStmt           :

     C                                                 startAt            :

     C                                                 replaceLength)

     C                   enddo



     C                   return    htmlStmt



     P ReplaceToken    e

** CTDATA arrHtml

<html>

<head>

  <title>TESTCGI Response Page</title>

</head>

<body>

  <h1>The TESTCGI program has completed</h1>

  <hr>

  <br>

  <b>The following input was received:</b>

  <br>

  <br>

  Name:      <%= FORM_DBNAME %><br>

  Company:   <%= FORM_DBCOMP %><br>

  Address:   <%= FORM_DBADDR %><br>

  City:      <%= FORM_DBCITY %>&nbsp;&nbsp;

  State:     <%= FORM_DBSTAT %>&nbsp;&nbsp;Zip:  <%= FORM_DBZIP %><br>

  Telephone: <%= FORM_DBPHON %><br>

  <br>

  <hr>

  <br>

  <a href="/html/testcgi.html">Return to submission form<a>

</body>

</html>