**************************************************************************
* 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
|
Member
TEMPLATE4
in
CGIDEV2 / QRPGLESRC