*********************************************************************
* RPG ILE MODULE CGIDEV2/BOATSCH2
*
* After compiling this RPG MODULE,
* create the related program with the following command:
*
* CRTPGM CGIDEV2/BOATSCH2 MODULE(CGIDEV2/BOATSCH2) ACTGRP(BOATSCH2)
*
*********************************************************************
* MAIN PROGRAM FLOW
*
* 1 - Receives input from BOATSCH1 output html
* (see member BOATSCH1 in source file CGIDEV2/BOATHTML)
* telling which boats should be displayed
* from file CGIDEV2/BOATSALE1 (boats for sale)
* 2 - Loads the html output skeleton from
* member BOATSCH2 in source file CGIDEV2/BOATHTML
* 3 - If the first time through,
* overrides and opens file BOATSALE1
* 4 - Writes html output section top
* 5 - Retrieves the occurrencies of "serno" in the input string.
* For each entry (boat serial number) in this array:
* - gets related boat data from BOATSALE1 record
* - sets variables (boat gif, boat length, make, etc)
* and writes html output section found
* - retrieves and writes out boat dependent html
* This is rather tricky.
* Boat dependent html text (boat features, interior jpg's, etc)
* cannot be in the skeleton html text. Instead, the skeleton
* contains a section, named text, with a single variable,
* named /%text%/.
* On the other side, in library CGIDEV2 there is a source
* physical file (named BOATTXTS), with an html text member
* for each boat serial number.
* The following is done:
* -assign and open the appropriate member
* of file CGIDEV2/BOATTXTS
* -read each record, set variable /%text%/ to contain
* the corresponding html text line, write section text.
* 6 - When no more occurrencies of "serno" in the input string,
* writes html output section htmlend (end html),
* and returns.
*********************************************************************
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
* Boats for sale data base file (LF on BOATSALE by boat serial number)
FBOATSALE1 if e k disk USROPN
F extfile('CGIDEV2/BOATSALE1')
* Boat dependent HTML text
FBOATTXTS if e disk USROPN
F RENAME(BOATTXTS:TXTREC)
F extfile('CGIDEV2/BOATTXTS')
F extmbr(TxtMbr)
* HTTP links
FBOATLINKS if e k disk USROPN
F extfile('CGIDEV2/BOATLINKS')
*--------------------------------------------------------------------
* Prototype definitions and standard system API error structure
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
* Variables common to CGI programs
/copy CGIDEV2/qrpglesrc,variables3
*--------------------------------------------------------------------
* VARIABLES SPECIFIC TO THIS PROGRAM
*--------------------------------------------------------------------
* Variables received from the input string
D lng s 2
D BckGnd s 10
D quit s 4
* Variables used to load the external html source member
D Lib s 10
D Fn s 10
D Mbr s 10
* Boats serial numbers received in the input string
D ItemCount s 10i 0
D SernoC s 7a
D i s 10i 0
* Member name for file BOATTXTS
D DS
DTxtMbr 1 10
DTxtMbr1 1 3
DTxtMbr2 4 10
* Command to be executed
D Command s 256a
* Switches
D GetLinkSW s 1a
D BoatSaleSW s 1a
D SomeBoatSW s 1a
* For Monthly Estimator Url substitution
D EstKwd s 13a INZ('/%ESTIMATOR%/')
D EstKwdLen s 10i 0 INZ(%size(EstKwd))
D SrcArr1 s 1a dim(80)
D SrcArr2 s 1a dim(80)
*
D bnbrC s 7a
D Align s 5a
D r s 10i 0
* Fields required by CHKNBR subprocedure
D ChkNbrDs ds
D anyerrs n
D invalidchrs n
D multdecpts n
D multsigns n
D nonbrs n
D toobig n
D lessthan0 n
D maxdigits s 10i 0
D badNumSW s n
*--------------------------------------------------------------------
* Prolog common to CGI programs
* -Receive input from the remote browser
*--------------------------------------------------------------------
/copy CGIDEV2/qrpglesrc,prolog3
*=====================================================================
* MAIN PROCESSING LINE
*=====================================================================
xxxxx * Get program start time for calculating execution time
xxxxxC time timedata1
* Parse input string
C exsr Parse
* Set output skeleton html member name
C exsr SetSkl
* Read skeleton output html into core
C callp gethtml(fn:lib:mbr:'')
* Retrieve environment variables
C exsr RtvEnvVar
* Get http links
C exsr GetLinks
* Assign data base file BOATSALE1, the open it
C BoatSaleSW ifeq *blank
C eval BoatSaleSW = 'x'
C open BOATSALE1 50
C endif
* Issue html section top
C exsr SetTop
C callp wrtsection('top')
*------------------
* Retrieve number of boats to be shown
C eval ItemCount = ZhbGetVarCnt('serno')
* Show the requested boats
C eval i =1
C i DOUGT ItemCount
C eval SernoC = ZhbGetVar('serno':i)
C move SernoC bnbr
C exsr ChkSerNoc check numeric input
C if badNumSw=*on invalid numric input
C eval i+=1
C iter ignore this input
C endif
C eval bnbr=c2n2(SernoC)
C bnbr chain BOATRC 60
C *in60 ifeq '0'
C exsr SetFound
C callp wrtsection('found')
C exsr MoreText
C else
C callp wrtsection('notfound')
C endif
C eval i+=1
C ENDDO
* If no boats selected
C ItemCount ifeq 0
C callp wrtsection('noselect')
C endif
* Send output buffer and quit
C exsr Exit
*=====================================================================
* Send output buffer and quit
*=====================================================================
C Exit begsr
* Compute and display run time
C time timedata2
C timedata2 subdur timedata1 ms:*ms
C eval sec = ms / 1000000
C callp updhtmlvar('runtime':
C %trim(%editw(sec:' 0 . ')))
C callp wrtsection('endhtml')
* Do not delete the call to wrtsection with section name *fini. It is needed
* to ensure that all output html that has been buffered gets output.
C callp wrtsection('*fini')
*
C quit ifne *blank
C close BOATSALE1
C eval *inlr = *on
C endif
*
C return
C endsr
*=====================================================================
* Parse input string
*=====================================================================
C Parse begsr
C eval lng = zhbgetvar('lng')
C eval BckGnd = zhbgetvar('bckgnd')
C eval quit = zhbgetvar('quit')
* Convert to uppercase
C eval lng = uppify(lng)
C eval BckGnd = uppify(BckGnd)
C endsr
*=====================================================================
* Additional boat dependent html text
* output html sections textxx
*=====================================================================
C MoreText begsr
* Assign and open database file BOATTXTS
C eval TxtMbr1 = 'MBR'
C move bnbr TxtMbr2
C open BOATTXTS
*
C do *hival
C read txtrec 40
C *in40 ifeq '1'
C leave
C endif
C exsr SetText
C callp wrtsection('text')
C enddo
*
C close BOATTXTS
C callp wrtsection('eotext')
C endsr
*---------------------------------------------------------------------
* Get http links
*---------------------------------------------------------------------
C GetLinks begsr
C GetLinkSW IFEQ *blank
* Assign and open database file BOATLINKS to CGIDEV2/BOATLINKS
C eval GetLinkSW = 'x'
C open BOATLINKS
* Get Monthly Estimator http link into field "estimadr"
C *like define lnkadr estimadr
C eval lnkkey = 'ESTIMATOR'
C lnkkey chain lnkrec 60
C *in60 ifeq '0'
C eval estimadr = lnkadr
C endif
* Close file (will not be needed the next time through)
C close BOATLINKS
C ENDIF
C endsr
*=====================================================================
* Set html output variables for section top
*=====================================================================
C SetTop begsr
* Repeat national language for the next invocation
C callp updhtmlvar('LNG':lng:
C InitHTMLVars)
* Repeat background color for the next invocation
C callp updhtmlvar('BCKGND':bckgnd)
* Color for text, background, links, visited links, active links
C exsr SetColor
* Protocol
C callp updHtmlVar('PROTOCOL':S_Protocol)
C endsr
*=====================================================================
* Set html output variables for section found (display a boat)
*=====================================================================
C SetFound begsr
* Boat serial number (numeric, converted to char
C movel(p) bnbr bnbrC
C callp updHtmlVar('BNBR':bnbrC )
* Boat type
C callp updHtmlVar('BTYPE':btype)
* Boat maker
C callp updHtmlVar('BMAKER':bmaker)
* Boat name
C callp updHtmlVar('BNAME':bname)
* Boat length (numeric, edited)
C callp updhtmlvar('BLEN':
C %trim(%editc(blen:'J')))
* Boat year built (numeric, edited)
C callp updhtmlvar('BYEAR':
C %trim(%editc(byear:'4')))
* Boat price (numeric, edited)
C bprice ifeq 0
C callp updhtmlvar('BPRICE':'to be defined ')
C else
C callp updhtmlvar('BPRICE':
C %trim(%editw(bprice:' , , , 0 $')))
C endif
* Boat city where located
C callp updhtmlvar('BCITY':bcity)
* Boat state where located
C callp updhtmlvar('BSTATE':bstate)
* Boat country where located
C callp updhtmlvar('BCTRY':bctry)
* Boat gif name
C bgif ifeq *blanks
C move bnbr bgif
C endif
C callp updhtmlvar('BGIF':bgif)
c* Gif alignment
C balign ifeq *blank
C eval balign ='L'
C endif
C balign ifeq 'R'
C eval align = 'right'
C else
C eval align = 'left'
C endif
C callp updhtmlvar('BALIGN':align)
c* Gif horizontal spacing
C bhspac ifeq 0
C eval bhspac =8
C endif
C callp updhtmlvar('BHSPAC':
C %trim(%editc(bhspac:'1')))
c* Gif vertical spacing
C bvspac ifeq 0
C eval bvspac=5
C endif
C callp updhtmlvar('BVSPAC':
C %trim(%editc(bvspac:'1')))
*
C endsr
*=====================================================================
* Set output variables for section text
*=====================================================================
C SetText begsr
* Substitute /%ESTIMATOR%/ with corresponding URL in "srcdta"
C exsr EstURL
* Additional boat dependent html text line
C callp updhtmlvar('TEXT':srcdta)
*
C endsr
*=====================================================================
* Substitute /%ESTIMATOR%/ with corresponding URL in "srcdta"
*=====================================================================
C EstURL begsr
C *like define srcdta srcdta1
* If /%ESTIMATOR%/ not in "srcdta", exit routine
C EstKwd scan srcdta r
C r cabeq 0 EstURLX
* *
* "estimadrL" = length of URL "estimadr"
C ' ' checkr estimadr estimadrL 3 0
* "len1" = length of text preeceding /%ESTIMATOR%/
C z-add r len1 3 0
C eval len1 = len1 - 1
* "start2 = start of text following /%ESTIMATOR%/
C z-add r start2 3 0
C eval start2 = start2 + EstKwdLen
* "len2" = fittable length of text following /%ESTIMATOR%/
C z-add 80 len2 3 0
C eval len2 = len2 - len1 - estimadrL
* perform substitution
C eval srcdta1 = %subst(srcdta:1:len1)
C eval srcdta1 = %trimr(srcdta1) + estimadr
C eval srcdta1 = %trimr(srcdta1) +
C %subst(srcdta:start2:len2)
C eval srcdta = srcdta1
*
C EstURLX tag
C endsr
*=====================================================================
* Color for text, background, links, visited links, active links
*=====================================================================
C SetColor begsr
C eval BckGnd = uppify(BckGnd)
C callp updhtmlvar('TXTCOLOR':'black')
C callp updhtmlvar('BOLD':' ')
* BGCOLOR white, LINK blue, VLINK red, ALINK green
C bckgnd ifeq 'WHITE'
C bckgnd oreq *blank
C callp updhtmlvar('BGCOLOR':'FFFFFF')
C callp updhtmlvar('LINK':'0000FF')
C callp updhtmlvar('VLINK':'FF0000')
C callp updhtmlvar('ALINK':'00FF00')
C endif
* BGCOLOR gray, LINK blue, VLINK red, ALINK green
C bckgnd ifeq 'GRAY'
C callp updhtmlvar('BGCOLOR':'CCCCCC')
C callp updhtmlvar('LINK':'0000FF')
C callp updhtmlvar('VLINK':'FF0000')
C callp updhtmlvar('ALINK':'00FF00')
C endif
* BGCOLOR light blue, LINK blue, VLINK red, ALINK green
C bckgnd ifeq 'LBLUE'
C callp updhtmlvar('BGCOLOR':'5BE6F3')
C callp updhtmlvar('LINK':'0000FF')
C callp updhtmlvar('VLINK':'FF0000')
C callp updhtmlvar('ALINK':'00FF00')
C endif
* BGCOLOR black, LINK green, VLINK red, ALINK white
C bckgnd ifeq 'BLACK'
C callp updhtmlvar('TXTCOLOR':'white')
C callp updhtmlvar('BGCOLOR':'000000')
C callp updhtmlvar('LINK':'00FF00')
C callp updhtmlvar('VLINK':'FF0000')
C callp updhtmlvar('ALINK':'FFFFFF')
C callp updhtmlvar('BOLD':'')
C endif
C endsr
*=====================================================================
* Set html output skeleton member before its read into memory
*=====================================================================
C SetSkl begsr
C eval lng = uppify(lng)
C eval Lib = 'CGIDEV2'
C eval Fn = 'DEMOHTML' + lng
C eval Mbr = 'BOATSCH2'
C endsr
*=====================================================================
* Retrieve environment variables
*=====================================================================
C RtvEnvVar begsr
* Use getenvp to get this server's protocol
C eval S_Protocol =getenv('SERVER_PROTOCOL':
C qusec)
*
C endsr
*=====================================================================
* Check numeric input field "sernoc"
*=====================================================================
C ChkSernoC begsr
C eval badNumSW=*off
* Check numeric input through subprocedure ChkNbr
C eval maxdigits=%size(sernoC)
C eval ChkNbrDs=chkNbr(sernoC:maxdigits)
C if anyerrs=*on
C eval badNumSw=*on
C endif
*
C endsr
|
