Learn from sources
       star Member TEMPLATE4 in CGIDEV2 / QRPGLESRC

       **************************************************************************
       * This material is provided by IBM for illustrative purposes             *
       * only and has not been thoroughly tested under all conditions.          *
       * IBM, therefore, cannot guarantee or imply reliability,                 *
       * serviceability, or function of this material.  IBM provides            *
       * no program services for this material.  All material contained         *
       * herein is provided to you "AS IS" without any warranties of            *
       * any kind.  THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS          *
       * FOR A PARTICULAR PURPOSE AND NON-INFRINGMENT ARE EXPRESSLY             *
       * DISCLAIMED.  SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION             *
       * OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSIONS MAY NOT APPLY           *
       * TO YOU.  IN NO EVENT WILL IBM BE LIABLE TO ANY PARTY FOR ANY           *
       * DIRECT, INDIRECT, SPECIAL OR OTHER CONSEQUENTIAL DAMAGES FOR           *
       * ANY USE OF THIS MATERIAL, INCLUDING, WITHOUT LIMITATION, ANY           *
       * LOST PROFITS, BUSINESS INTERRUPTION, LOSS OF PROGRAMS OR OTHER         *
       * DATA ON YOUR INFORMATION HANDLING SYSTEM OR OTHERWISE, EVEN            *
       * IF WE ARE EXPRESSLY ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.        *
       *                                                                        *
       * (C) Copyright IBM Corp. 1997, 2005                                     *
       * All rights reserved.                                                   *
       * US Government Users Restricted Rights -                                *
       * Use, duplication, or disclosure restricted                             *
       * by GSA ADP Schedule Contract with IBM Corp.                            *
       *                                                                        *
       * Licensed Materials - Property of IBM                                   *
       **************************************************************************
       * There are five versions of this template program:
 
       *                 Input                Parsing                 Get HTML
       *   Program       subprocedure         subprocedures           subprocedure
       *   --------      -------------        ---------------------   ------------
       *   TEMPLATE      getinput             cvtdb                   GetHtml
       *                                      cgivarcnt
       *                                      cgivarval
 
       *   TEMPLATE2     getinput             cgivarcnt               GetHtml
       *                                      cgivarval
 
       *   TEMPLATE3     zhbgetinput          zhbgetvarcnt            GetHtml
       *                                      zhbgetVar
 
       *   TEMPLATE4     zhbgetinput          zhbgetvarcnt            GetHtmlIfs
       *                                      zhbgetVar
 
       *   TEMPLATE5     zhbgetinput          zhbgetvarcnt            GetHtmlIfsMult
       *                                      zhbgetVar
 
       * This source member is a sample template.  Column 1-5 are coded
       * to make it easy to remove records that exist only as examples
       * and to find records that should be changed.
 
       * Columns 1 - 5    Meaning
       * --------------   -------------------------------------------
       * Blank            Should be left in your program
       * xxxxx            Example records (hoursop physical file,
       *                  getenv example, setting variable data, etc.)
       *                  Also optional output HTML for PSSR code.
       * ccccc            Records that should be changed in order
       *                  to tailor the template to your needs.
 
       /copy qrpglesrc,hspecs
       /copy qrpglesrc,hspecsbnd
 
       * For files or other objects that are not in the CGI program's library,
       * you can use the docmd subprocedure to add libraries to the library
       * or to perform file overrides before opening the file(s).  Although
       * that is not required in this program, the following file uses usropn.
 xxxxxFhoursop   if   e           k disk    usropn                               Hours of operation
 xxxxxF                                     infsr(*pssr)                         If error, use *pssr
       * Prototype definitions and standard system API error structure
       /copy qrpglesrc,prototypeb
       /copy qrpglesrc,usec
       * Number of variables
      DnbrVars          s             10i 0
 
       * Saved query string
      Dsavedquerystring...
      D                 s          32767    varying
 
       * Client input variables
 xxxxxD emailadd        s             40
 xxxxxD custname        s             40
 xxxxxD state           s              2
 xxxxxD years           s              6
 xxxxxD ordered         s              1
 xxxxxD catalog         s              1
 xxxxxD oses            s            300    varying
 
       * Constant for updHTMLvar subprocedure
      D initHTMLVars    c                   '0'
 
       * For program status data structure and program status subroutine
      D psds           sds                                                       Pgm status DS
      D   psdsdata                   429                                         The data
      D   PgmName                     10    overlay(psdsdata:1)
      D pssrswitch      s               n   inz(*off)                            switch for pssr
      D wrotetop        s               n   inz(*off)                            Whthr top sec wrtn
 
 xxxxx * Variables for retrieving cgi variable counts and numbers
 xxxxxD oscount         s             10i 0
 xxxxxD varocc          s             10i 0                                      occurrence
 
       * Return code
      D rc              s             10i 0 inz(0)                               return code
 
       * Indicators for chknbr subprocedure
      D ChkNbrInds      ds
      D  Indicators                     n   dim(7)
 
 xxxxx * Program timing variable
 xxxxxD sec             s             15p 6
 
       * Inititailization complete switch
      D InitComplete    s               n
 
 xxxxx * Try again message
 xxxxxD TryAgain        c                   'You can use the back button -
 xxxxxD                                     and try again if you want to.'
       ****************************************************************************
       * Mainline
       ****************************************************************************
 xxxxx * Change the next statement to SetNoDebug(*on)
 xxxxx * if no debugging output is to be produced.
 xxxxx * Do this only if maximum performance is required.
 xxxxxC                   callp     SetNoDebug(*off)
       * Initialization
      C                   exsr      Initialize
 xxxxx * Write qualified job name to debug file.  The *on
 xxxxx * parameter forces output even if debugging is off.
 xxxxx * Remove this parameter or change it to *off if you
 xxxxx * want the output only if debugging is on.
 xxxxxC*                  callp     wrtjobdbg(*on)
 xxxxxC                   callp     wrtjobdbg
       * Read externally defined output html
 cccccC                   callp     gethtmlifs('/CgidevExtHtml/talk2ifs.html':
      C                             '«as400»')
       * Get input
      C                   eval      nbrVars =
      C                             zhbgetinput(savedquerystring:qusec)
       * Abort if any errors.
      C                   if        qusbavl » 0
      C                   exsr      *pssr
      C                   endif
 
       * Get input variables
 xxxxx * Customer name
 xxxxxC                   eval      custname = zhbgetvar('custname')
 xxxxx * E-mail address
 xxxxxC                   eval      emailadd = zhbgetvar('emailadd')
 xxxxx * State
 xxxxxC                   eval      state = zhbgetvar('state')
 xxxxx * Years
 xxxxxC                   eval      years = zhbgetvar('years')
 xxxxx * Ordered
 xxxxxC                   eval      ordered = zhbgetvar('ordered')
 xxxxx * Catalog
 xxxxxC                   eval      catalog = zhbgetvar('catalog')
 xxxxx *
 xxxxx * Edit input
 xxxxx * Name
 xxxxxC                   if        custname = *blanks
 xxxxxC                   eval      rc = addmsg('Name':1)
 xxxxxC                   eval      rc = addmsg('Was blank.':2)
 xxxxxC                   eval      rc = addmsg(TryAgain:3)
 xxxxxC                   endif
 xxxxx * E-mail address
 xxxxxC                   if        emailadd = *blanks
 xxxxxC                   eval      rc = addmsg('E-mail address':1)
 xxxxxC                   eval      rc = addmsg('Was blank.':2)
 xxxxxC                   eval      rc = addmsg('We won''t -
 xxxxxC                             be able to send you an informational -
 xxxxxC                             package.':2)
 xxxxxC                   eval      rc = addmsg(TryAgain:3)
 xxxxxC                   endif
 xxxxx * Years, should be a valid number.  If errors are found, messages
 xxxxx * are written into the service program's error arrays.
 xxxxxC                   eval      chknbrinds = chknbr(%trim(years):3:*on:
 xxxxxC                             'Years at address':*on)
 xxxxx * Set up data for writing standard output.
 xxxxxC                   callp     updHTMLvar('custname':custname:InitHTMLVars)
 xxxxxC                   callp     updHTMLvar('emailadd':emailadd)
 xxxxxC                   callp     updHTMLvar('state':state)
 xxxxxC                   if        not indicators(1)
 xxxxxC                   callp     updHTMLvar('years':%editc(
 xxxxxC                             %dech(c2n2(years):5:2):'N'))
 xxxxxC                   else
 xxxxxC                   callp     updHTMLvar('years':years)
 xxxxxC                   endif
       * Clear the HTML buffer
      C                   callp     ClrHtmlBuffer
       * Write sections of HTML.
      C                   callp     wrtsection('top')
      C                   eval      wrotetop = *on                               For pssr
       * If any errors, write error messages
      C                   if        GetMsgCnt » 0
      C                   callp     WrtMsgs
      C                   endif
 xxxxxC                   callp     wrtsection('top2')
 xxxxx * Write ordered information
 xxxxxC                   select
 xxxxxC                   when      ordered = '1'
 xxxxxC                   callp     wrtsection('youhave ordered')
 xxxxxC                   when      ordered = '2'
 xxxxxC                   callp     wrtsection('youhave not ordered')
 xxxxxC                   other
 xxxxxC                   callp     wrtsection('youdidnotsay ordered')
 xxxxxC                   endsl
 xxxxx *
 xxxxx * Write catalog information
 xxxxxC                   select
 xxxxxC                   when      catalog = '1'
 xxxxxC                   callp     wrtsection('youhave catalog')
 xxxxxC                   when      catalog = '2'
 xxxxxC                   callp     wrtsection('youhave not catalog')
 xxxxxC                   other
 xxxxxC                   callp     wrtsection('youdidnotsay catalog')
 xxxxxC                   endsl
 xxxxx * Example of multiple occurrence field, OS (operating systems)
 xxxxx *    Get os count
 xxxxxC                   eval      oscount = zhbgetvarcnt('os')
 xxxxxC                   if        oscount = 0
 xxxxxC                   callp     wrtsection('nooses')                         Write nooses section
 xxxxxC                   else                                                   1+ occurrences
 xxxxx *    Build string to containing oses
 xxxxxC                   eval      oses = ''
 xxxxxC                   do        oscount       varocc
 xxxxx * Concatenate this os to any previous oses, appending a comma at the end
 xxxxxC                   eval      oses = oses +
 xxxxxC                             zhbgetvar('os':varocc) + ', '
 xxxxxC                   enddo
 xxxxx * Change last comma to a period
 xxxxxC                   eval      %subst(oses:%len(oses)-1:1) = '.'
 xxxxx * Update HTML data
 xxxxxC                   callp     updHTMLvar('oses':oses)
 xxxxxC                   callp     updHTMLvar('oscount':%editc(oscount:'N'))
 xxxxxC                   callp     wrtsection('os')                             Write os section
 xxxxxC                   endif                                                  oscount = 0
 xxxxx * Write table containing hours of operation information
 xxxxxC                   callp     wrtsection('tabletop')
 xxxxx * Output hours of operation table rows by writing the tablerow section
 xxxxx * once for each record in hoursop physical file
 xxxxxC     1             setll     hoursop
 xxxxxC                   read      hoursrec                                     Read record
 xxxxxC                   dow       not %eof                                     Loop
 xxxxxC                   callp     updHTMLvar('days':days)
 xxxxxC                   callp     updHTMLvar('hours':hours)
 xxxxxC                   callp     wrtsection('tablerow')                       Write tablerow sect
 xxxxxC                   read      hoursrec                                     Read record
 xxxxxC                   enddo
 xxxxxC                   callp     wrtsection('tablebot')                       Table bottom, etc.
 xxxxx * If we have e-mail address, say we will send package.  Else,
 xxxxx * say we won't and give opportunity to re-enter.
 xxxxxC                   if        emailadd = *blanks
 xxxxxC                   callp     wrtsection('WeWontSend')
 xxxxxC                   else
 xxxxxC                   callp     wrtsection('WeWillSend')
 xxxxxC                   endif
 xxxxx * Use getenv to get this server's protocol and server software
 xxxxx * (illustrates getting environment variables and updating HTML
 xxxxx * variables at the same time)
 xxxxxC                   callp     UpdHtmlVar('protocol':
 xxxxxC                             getenv('SERVER_PROTOCOL':qusec))
 xxxxxC                   callp     UpdHtmlVar('ServerSoftware':
 xxxxxC                             getenv('SERVER_SOFTWARE':qusec))
 xxxxx * Get updated counter for this program and update its HTML variabile
 xxxxxC                   callp     updHTMLvar('counter':
 xxxxxC                             %editc(countp('RPG TEMPLATE 4'):'N'))
 xxxxx * Send rest of information
 xxxxxC                   callp     wrtsection('RestOfInfo')
 xxxxx * Get and write run time
 xxxxxC                   eval      sec = TimerElapsed()
 xxxxxC                   callp     wrtdebug(PgmName +
 xxxxxC                             ': Execution time (seconds) ' +
 xxxxxC                             %trim(%editc(sec:'N')):*on)
 xxxxxC                   callp     updhtmlvar('runtime':%editc(sec:'N'))
 xxxxxC                   callp     wrtsection('runtime')
       * Write the *fini section to ensure all buffered output is sent
       * to the browser.
      C                   callp     wrtsection('endhtml *fini')                  «/body» «/html» fini
      C                   return
 
       ****************************************************************************
      C     Initialize    begsr
       ****************************************************************************
       * Initialization
 
       * Do every time
 xxxxx *   Get program start time for calculating execution time
 xxxxxC                   callp     TimerStart
       *   Clear messages
      C                   callp     ClrMsgs
 
       * First time only
      C                   if        not InitComplete
      C                   eval      InitComplete = *on
 xxxxx *  Open HOURSOP file
 xxxxxC                   open      hoursop
       *  Set up message handling section names (if default names are
       *  used, there is no need to program this call.  Done for
       *  illustrative purposes).
      C                   callp     CfgMsgs('msgtext':'msgstart':'msgend':
      C                                     'msgl1':'msgl2':'msgl3')
      C                   endif
      C                   endsr
       ****************************************************************************
       * Program status subroutine
       ****************************************************************************
      C     *pssr         begsr
       * If have already been in pssr, get out to avoid looping
      C                   if        pssrswitch=*on
      C                   eval      *inlr = *on
      C                   return
      C                   endif
       * Set on switch to indicate we've been here
      C                   eval      pssrswitch=*on
       * Write HTML sections (top if not already done, pssr, endhtml and *fini)
      C                   if        wrotetop=*off
       * Clear the HTML buffer
      C                   callp     ClrHtmlBuffer
      C                   callp     wrtsection('top')
      C                   endif
      C                   callp     wrtsection('pssr endhtml *fini')
       * Send psds data to cgidebug physical file
      C                   callp     wrtpsds(psds)
      C                   eval      *inlr = *on
      C                   return
      C                   endsr
0.078 sec.s