Learn from sources
       Member TEMPLATE5 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:
 
       * The first four are considered obsolete and are not recommended
       * for use in developing production programs.
 
       * TEMPLATE5 uses the latest CGIDEV2 subprocedures and is
       * writen using RPG-IV's free-form syntax.
 
       *                 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
 
       * Indicators for GetHtmlIfsMult subprocedure
      D IfsMultIndicators...
      d                 ds
      D  NoErrors                       n
      D  NameTooLong                    n
      D  NotAccessible                  n
      D  NoFilesUsable                  n
      D  DupSections                    n
      D  FileIsEmpty                    n
 
       * 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.'
 xxxxx * Arrays for days of week and hours of operation
 xxxxxD DaysArr         s             15    dim(7) varying
 xxxxxD HoursArr        s             20    dim(7) varying
 
       * Work variable
      D i               s             10i 0
       /free
        // *************************************************************************
        // 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.
 xxxxx  SetNoDebug(*off);
 
        // Initialization
        exsr Initialize;
 
 xxxxx  // Write qualified job name to debug file.  The *on
 xxxxx  // parametera forces output even if debugging is off.
 xxxxx  // Removel thisiparameter or change it to *off if you
 xxxxx  // want the output only if debugging is on.
 xxxxx  //wrtjobdbg(*on);
 xxxxx  wrtjobdbg();
 
        // Read externally defined output html files
 ccccc  IfsMultIndicators = gethtmlifsmult('/CgiDevExtHtml/StdTop.Html +
 ccccc                      /CgidevExtHtml/StdRunTime.Html +
 ccccc                      /CgidevExtHtml/StdMsg.Html +
 ccccc                      /CgidevExtHtml/StdPssr.Html +
 ccccc                      /CgidevExtHtml/Talk2Stuff.Html +
 ccccc                      /CgidevExtHtml/StdEnd.Html':'«as400»');
 
        // Get input
        nbrVars = zhbgetinput(savedquerystring:qusec);
 
        // Abort if any errors
        if qusbavl » 0;
          exsr *pssr;
        endif;
 
        // Get variables
 
 xxxxx  // Customer name
 xxxxx  custname = zhbgetvar('custname');
 xxxxx
 xxxxx  // E-mail address
 xxxxx  emailadd = zhbgetvar('emailadd');
 xxxxx
 xxxxx  // State
 xxxxx  state = zhbgetvar('state');
 xxxxx
 xxxxx  // Years
 xxxxx  years = zhbgetvar('years');
 xxxxx
 xxxxx  // Ordered
 xxxxx  ordered = zhbgetvar('ordered');
 xxxxx
 xxxxx  // Catalog
 xxxxx  catalog = zhbgetvar('catalog');
 xxxxx
 xxxxx  // Edit input
 xxxxx
 xxxxx  // Name
 xxxxx  if custname = *blanks;
 xxxxx    rc = addmsg('Name':1);
 xxxxx    rc = addmsg('Was blank.':2);
 xxxxx    rc = addmsg(TryAgain:3);
 xxxxx  endif;
 xxxxx
 xxxxx  // E-mail address
 xxxxx  if emailadd = *blanks;
 xxxxx    rc = addmsg('E-mail address':1);
 xxxxx    rc = addmsg('Was blank.':2);
 xxxxx    rc = addmsg('We won''t be able to send you an informational +
 xxxxx                 package.':2);
 xxxxx    rc = addmsg(TryAgain:3);
 xxxxx  endif;
 xxxxx
 xxxxx  // Years, should be a valid number.  If errors are found, messages
 xxxxx  // are written into the service program's error arrays.
 xxxxx  chknbrinds = chknbr(%trim(years):3:*on:'Years at address':*on);
 xxxxx
 xxxxx  // Set up data for writing standard output.
 xxxxx  updHTMLvar('custname':custname:InitHTMLVars);
 xxxxx  updHTMLvar('emailadd':emailadd);
 xxxxx  updHTMLvar('state':state);
 xxxxx  if not Indicators(1);
 xxxxx    updHTMLvar('years':%editc(%dech(c2n2(years):5:2):'N'));
 xxxxx  else;
 xxxxx    updHTMLvar('years':years);
 xxxxx  endif;
 xxxxx  UpdHtmlVar('title':'Computer Discount House');
 
        //  Clear the HTML buffer
        ClrHtmlBuffer();
 
        // Write sections of HTML.
        wrtsection('top');
        wrotetop = *on;
 
        // If any errors, write error messages
        if GetMsgCnt » 0;
          WrtMsgs();
          endif;
 xxxxx    wrtsection('top2');
 xxxxx
 xxxxx  // Write ordered information
 xxxxx  select;
 xxxxx    when ordered = '1';
 xxxxx      wrtsection('youhave ordered');
 xxxxx    when ordered = '2';
 xxxxx      wrtsection('youhave not ordered');
 xxxxx    other;
 xxxxx      wrtsection('youdidnotsay ordered');
 xxxxx  endsl;
 xxxxx
 xxxxx  // Write catalog information
 xxxxx  select;
 xxxxx    when catalog = '1';
 xxxxx      wrtsection('youhave catalog');
 xxxxx    when      catalog = '2';
 xxxxx      wrtsection('youhave not catalog');
 xxxxx    other;
 xxxxx      wrtsection('youdidnotsay catalog');
 xxxxx  endsl;
 xxxxx
 xxxxx  // Example of multiple occurrence field, OS (operating systems)
 xxxxx  // Get os count
 xxxxx  oscount = zhbgetvarcnt('os');
 xxxxx  if oscount = 0;
 xxxxx    wrtsection('nooses');  // Write nooses section
 xxxxx  else;                    // 1 + occurrences
 xxxxx    // Build string to containing oses
 xxxxx    oses = '';
 xxxxx    for varocc = 1 to oscount;
 xxxxx      // Concatenate this os to any previous oses, appending a comma at the end
 xxxxx      oses = oses +  zhbgetvar('os':varocc) + ', ';
 xxxxx    endfor;
 xxxxx    // Change last comma to a period
 xxxxx    %subst(oses:%len(oses)-1:1) = '.';
 xxxxx    // Update HTML data
 xxxxx    updHTMLvar('oses':oses);
 xxxxx    updHTMLvar('oscount':%editc(oscount:'N'));
 xxxxx    wrtsection('os');                          // Write os section
 xxxxx  endif;                                       // oscount = 0
 xxxxx
 xxxxx  // Write table containing hours of operation information
 xxxxx  wrtsection('tabletop');
 xxxxx  // Output hours of operation table rows by writing the tablerow section
 xxxxx  // once for each record in hoursop physical file
 xxxxx  for i = 1 to 7;
 xxxxx    updHTMLvar('days':daysarr(i));
 xxxxx    updHTMLvar('hours':hoursarr(i));
 xxxxx    wrtsection('tablerow');                    // Write tablerow sect
 xxxxx  endfor;
 xxxxx  wrtsection('tablebot');                      // Table bottom, etc.
 xxxxx
 xxxxx  // If we have e-mail address, say we will send package.  Else,
 xxxxx  // say we won't and give opportunity to re-enter.
 xxxxx  if emailadd = *blanks;
 xxxxx    wrtsection('WeWontSend');
 xxxxx  else;
 xxxxx    wrtsection('WeWillSend');
 xxxxx  endif;
 xxxxx
 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)
 xxxxx  UpdHtmlVar('protocol':getenv('SERVER_PROTOCOL':qusec));
 xxxxx  UpdHtmlVar('ServerSoftware':getenv('SERVER_SOFTWARE':qusec));
 xxxxx
 xxxxx  // Get updated counter for this program and update its HTML variabile
 xxxxx  updHTMLvar('counter':%editc(countp('RPG TEMPLATE 5'):'N'));
 xxxxx
 xxxxx  // Send rest of information
 xxxxx  wrtsection('RestOfInfo');
 xxxxx
 xxxxx  // Get and write run time
 xxxxx  sec = TimerElapsed();
 xxxxx  wrtdebug(PgmName + ': Execution time (seconds) ' +
 xxxxx            %trim(%editc(sec:'N')):*on);
 xxxxx  updhtmlvar('runtime':%editc(sec:'N'));
 xxxxx  wrtsection('runtime');
 
        // Write the *fini section to ensure all buffered output is sent
        // to the browser.
        wrtsection('endhtml *fini');
        return;
 
        // *************************************************************************
        // Initialize subroutine
        // *************************************************************************
 
        Begsr Initialize;
        // Initialization
 
        // Do every time
 
 xxxxx  // Get program start time for calculating execution time
 xxxxx    TimerStart();
 
        //   Clear messages
          ClrMsgs();
 
        // First time only
          if not InitComplete;
            InitComplete = *on;
 
 xxxxx  // Open, read, and close HOURSOP file
 xxxxx      open hoursop;
 xxxxx      setll 1 hoursop;
 xxxxx      for i = 1 to 7;
 xxxxx        read hoursrec;
 xxxxx        daysarr(i) = %trimr(days);
 xxxxx        hoursarr(i) = %trimr(hours);
 xxxxx      endfor;
 xxxxx      close hoursop;
 
        // Set up message handling section names (if default names are
        // used, there is no need to program this call.  Done for
        // illustrative purposes).
            CfgMsgs('msgtext':'msgstart':'msgend':'msgl1':'msgl2':'msgl3');
          endif;
        endsr;
 
        // *************************************************************************
        // Program status subroutine
        // *************************************************************************
        begsr *pssr;
        // If have already been in pssr, get out to avoid looping
          if pssrswitch=*on;
            eval      *inlr = *on;
            return;
          endif;
 
        // Set on switch to indicate we've been here
          pssrswitch=*on;
 
        // Clear the HTML buffer
           ClrHtmlBuffer();
 
        // Write HTML sections (top if not already done, pssr, endhtml and *fini)
           if not wrotetop;
             wrtsection('top');
           endif;
           wrtsection('pssr endhtml *fini');
        // Send psds data to cgidebug physical file
           wrtpsds(psds);
           *inlr = *on;
           return;
         endsr;
       /end-free
0.103 sec.s