**************************************************************************
* 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':'');
// 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
|